home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Amiga Games: 500 MB Amiga Software
/
500 MB Amiga Software - Euber 130 - Amiga Games Disc & Mag.iso
/
userbox
/
publicdomain
/
muchmore46
/
src
/
muchmore.mod
next >
Wrap
Text File
|
1995-03-12
|
94KB
|
2,844 lines
(*---------------------------------------------------------------------------
:Program. MuchMore.mod
:Author. Fridtjof Siebert
:Address. Nobileweg 67, D-70439 Stuttgart, Germany
:Shortcut. [fbs]
:Copyright. Freeware
:Language. Oberon-2
:Translator. Amiga Oberon Compiler v3.10
:History. V1.0 summer-88: First very slow internal version [fbs]
:History. V1.1 24-Sep-88: First published version [fbs]
:History. V1.2 26-Nov-88: Now displays Filelength & Percentage [fbs]
:History. 27-Nov-88: Mouse can be used instead of Space/BackSpace [fbs]
:History. V1.3 29-Apr-89: Strong increase in speed, removed WarpText [fbs]
:History. 29-Apr-89: Now supports Numeric Keys (Home,PgUp etc.) [fbs]
:History. 29-Apr-89: Now opens Screen as big as gfx.normalDisplay [fbs]
:History. V1.4 29/30-Apr-89: Asynchronus loading/displaying. Very nice [fbs]
:History. 30-Apr-89, 00:33: Removed bugs in Filelength & L-Command[fbs]
:History. 30-Apr-89, 02:21: Added Find-Command [fbs]
:History. 30-Apr-89, 10:30: Scrolling stops when window inactive [fbs]
:History. 01-May-89: Allocates no more unneeded memory for text [fbs]
:History. 07-May-89: Allocates even less memory now [fbs]
:History. 14-May-89: Removed deadlock-bug with Find-Window [fbs]
:History. V1.5 25-May-89: Added print feature [fbs]
:History. 25-May-89: Removed all imports (apart from Arts) [fbs]
:History. 26-May-89: inspired by J. Kupfer, I added nk 5 to quit [fbs]
:History. 26-May-89: Now handle BS correctly [fbs]
:History. V1.6 02-Jul-89: Now supports several fontstyles and colors [fbs]
:History. V1.7 03-Jul-89: Is again as fast as it was with 2 colors [fbs]
:History. 03-Jul-89: Now no more crashes when quitting while print[fbs]
:History. 07-Jul-89: removed bug with texts of length 0 [fbs]
:History. V1.8 10-Jul-89: small bug in find-command removed [fbs]
:History. 10-Jul-89: now found strings are highlighted [fbs]
:History. 14-Jul-89: nk0 to display fileinfo [fbs]
:History. V2.0 06-Aug-89: Ported this to OBERON [fbs]
:History. 06-Aug-89: Added ARP-FileRequester [fbs]
:History. 07-Aug-89: Added L - (load new file) Command [fbs]
:History. V2.1 03-Sep-89: no more gurus if an r/w error occures [fbs]
:History. 03-Sep-89: MM used to execute CSI-Codes backwards. fixed[fbs]
:History. 03-Sep-89: ping / pong with Shift+Fn / Fn [fbs]
:History. 03-Sep-89: new command: goto [fbs]
:History. V2.2 05-Sep-89: will run with any keymapping now [fbs]
:History. V2.3 17-Sep-89: New command: sleep & Pop-Up feature [fbs]
:History. 17-Sep-89: "MuchMore -s" will go to sleep immediately [fbs]
:History. 17-Sep-89: Interprets <CSI>m as <CSI>0m now [fbs]
:History. V2.4 17-Sep-89: New command: write block "w" [fbs]
:History. 17-Sep-89: rewritten argument parser to allow quotes [fbs]
:History. V2.5 18-Sep-89: now uses the 8x8 font set with SetFont [fbs]
:History. 19-Sep-89: no more scatters memory. Allocates 4K Chunks [fbs]
:History. V2.6 26-Jun-90: Made MuchMore reentrant [fbs]
:History. 26-Jun-90: Opens 1-Plane Screen if memory is rare [fbs]
:History. 26-Jun-90: Asynchronus fast scrolling with Ctrl-Up/Down [fbs]
:History. 26-Jun-90: Now supports interlaced screens [fbs]
:History. 08-Aug-90: CLI-Option '-l' to toggle interlaced mode [fbs]
:History. V2.7 09-Aug-90: no more RethinkDisplay()s,looks good with 2.0[fbs]
:History. 10-Aug-90: Supports Kick2.0 ASL-FileRequester [fbs]
:History. V2.8 26-Dez-90: Leaves space between lines on interl. scrns [fbs]
:History. V3.0 04-Jul-91: Supports any non-proportional font now [fbs]
:History. 04-Jul-91: no more supports '-s' (sleep),was rarely used[fbs]
:History. 04-Jul-91: new Options -f<font> and -s<size> for font [fbs]
:History. 09-Nov-91: Find works w/ dmouse(window may get inactive)[fbs]
:History. V3.1 04-Sep-92: Uses Screenmode of Workbench screen [fbs]
:History. V3.2 02-Nov-92: Supports non-scrollable screens [fbs]
:History. 02-Nov-92: Complete redraw doesn't scroll anymore [fbs]
:History. V3.2.1 24-Dec-92: XPK Support (C.Stiens)
:History. 24-Dec-92: New option -p for Password (C.Stiens)
:History. 24-Dec-92: New option -e for Extra Spacing (C.Stiens)
:History. 24-Dec-92: New option -c for Screen Colors (C.Stiens)
:History. 24-Dec-92: Tooltypes (C.Stiens)
:History. V3.2.2 08-Jan-93: Doesn't use MyMakeScreen() no more (C.Stiens)
:History. V3.2.3 08-Feb-93: Now closes Console Device (C.Stiens)
:History. 08-Feb-93: Non-Scroll Mode didn't work always (C.Stiens)
:History. 10-Feb-93: ScreenMode Requester (C.Stiens)
:History. 10-Feb-93: New Option -s for Scroll Mode (C.Stiens)
:History. 10-Feb-93: Busy Pointer (C.Stiens)
:History. 14-Feb-93: Now evals Tooltypes also on CLI start (C.Stiens)
:History. V3.2.4 15-Feb-93: Clears Idcmp while Busy (C.Stiens)
:History. 15-Feb-93: Bugs in GetString fixed (C.Stiens)
:History. 19-Feb-93: More Scrollmodes (C.Stiens)
:History. 20-Feb-93: Bug in Type() fixed (C.Stiens)
:History. V3.2.5 08-Mar-93: Asynch Scrolling changed (C.Stiens)
:History. 08-Mar-93: New Option -t for Taskpri (C.Stiens)
:History. 10-Mar-93: Now uses Dos.ReadArgs if KS 2.04 (C.Stiens)
:History. V3.2.6 19-Mar-93: scrollmode 3 now also scrolls soft (C.Stiens)
:History. 19-Mar-93: New Option -o for one plane (C.Stiens)
:History. 19-Mar-93: New Option -a for tab width (C.Stiens)
:History. 19-Mar-93: Removed QText (C.Stiens)
:History. 21-Mar-93: Opens screen with full overscan width (C.Stiens)
:History. 22-Mar-93: Filename can be on any pos at KS1.3 (C.Stiens)
:History. 27-Mar-93: New Option N=NOOSCAN (C.Stiens)
:History. V3.2.7 07-Apr-93: Dont pokes to bitmap no more (C.Stiens)
:History. V3.2.8 12-Apr-93: New Option B=PLANES (C.Stiens)
:History. V3.2.9 12-May-93: Implemented V36 ANSI Codes (C.Stiens)
:History. 3.2.10 16-May-93: Locale Support (C.Stiens)
:History. 16-May-93: DispMode-Requester font-sensitive (C.Stiens)
:History. V3.3 21-Jun-93: Code optimised (C.Stiens)
:History. 25-Jun-93: Safe quit (C.Stiens)
:History. V3.4 29-Jun-93: Clipboard support (C.Stiens)
:History. 29-Jun-93: took version number out of catalog (C.Stiens)
:History. V3.5 31-Jul-93: case sensitive search, Boyer-Moore Alg. (C.Stiens)
:History. V3.6 15-Aug-93: Page up/down with softscroll reimpl. (C.Stiens)
:History. 16-Aug-93: Flash at EOF/BOF (C.Stiens)
:History. V3.7 28-Oct-93: New option E=EDITOR (C.Stiens)
:History. 21-Nov-93: MM was not 100% pure (BusyPointer) (C.Stiens)
:History. 21-Nov-93: Password has to be entered in stringgad (C.Stiens)
:History. V4.0 07-Dec-93: MM can run in a WB Window (C.Stiens)
:History. 07-Dec-93: Options WINDOW, LEFT, TOP, WIDTH, HEIGHT(C.Stiens)
:History. 07-Dec-93: Kick 1.3 is no more supported (C.Stiens)
:History. 07-Dec-93: Removed Options SCROLLMODE and NOOSCAN (C.Stiens)
:History. V4.1 05-Jan-94: Prefs BusyPointer, set rp.mask or MaxPen(C.Stiens)
:History. 10-Jan-94: Pipe Support, new option PUBSCREEN (C.Stiens)
:History. 12-Jan-94: Option SCROLLMODE reintroduced (C.Stiens)
:History. 12-Jan-94: New Option I=INTERLEAVED (C.Stiens)
:History. V4.2 29-Jan-94: Zoom Gadget (v39) (C.Stiens)
:History. 29-Jan-94: Better test for Pipe (C.Stiens)
:History. 30-Jan-94: Icon is found if MM is started w/path (C.Stiens)
:History. 31-Jan-94: New option FASTQUIT (C.Stiens)
:History. 31-Jan-94: ShowTask allocates his signals now (C.Stiens)
:History. V4.3 06-Mar-94: Change rp.mask only if necessary (C.Stiens)
:History. 16-Mar-94: New options: FRWIDTH, FRHEIGHT (C.Stiens)
:History. 20-Mar-94: Hide password when entering (C.Stiens)
:History. V4.4 17-Jun-94: Bug in task sync fixed (C.Stiens)
:History. 17-Jun-94: Uses ASL ScreenMode Requester now (C.Stiens)
:History. V4.5 30-Jun-94: Bug w/ SetFont() fixed (C.Stiens)
:History. V4.6 18-Aug-94: Find command also with 's' key (C.Stiens)
:History. 09-Mar-95: Dont filters asciis 128-160 anymore (C.Stiens)
:Contents. A Soft-Scrolling ASCII-File Viewer.
:Remark. Compile: 'Oberon -svbcrntzdma MuchMore' for short code
:Remark. Compile: 'Oberon -dma MuchMore' for safe code
:Remark. Link: 'OLink -dma MuchMore'
---------------------------------------------------------------------------*)
MODULE MuchMore; (* $StackChk- *)
IMPORT loc:= Locale,
ip := IFFParse,
u := Utility,
con:= Console,
str:= Strings,
ie := InputEvent,
I := Intuition,
g := Graphics,
d := Dos,
e := Exec,
ol := OberonLib,
(* $IF quiet *) NoRequesters, (* $END *)
SYS:= SYSTEM;
CONST
MuchText = "MuchMore 4.6 © 1988-95 AMOK\o$VER: muchmore 4.6 (11.3.95)";
Version = "v4.6";
MSGOOM = 0;
MSGCOS = 1;
MSGCOW = 2;
MSGCOF = 3;
MSGRWERR = 4;
MSGRETRYABORT = 5;
MSGEMPTY = 6;
MSGSAVE = 7;
MSGUSE = 8;
MSGCANCEL = 9;
MSGOK = 10;
MSGCHOOSESM = 11;
MSGINFOFMT = 12;
MSGH1 = 13;
MSGH2 = 14;
MSGH3 = 15;
MSGH4 = 16;
MSGH5 = 17;
MSGH6 = 18;
MSGH7 = 19;
MSGH8 = 20;
MSGH9 = 21;
MSGH10 = 22;
MSGH11 = 23;
MSGH12 = 24;
MSGH13 = 25;
MSGH14 = 26;
MSGH15 = 27;
MSGH16 = 28;
MSGH17 = 29;
MSGH18 = 30;
MSGH19 = 31;
MSGH20 = 32;
MSGH21 = 33;
MSGH22 = 34;
MSGH23 = 35;
MSGH24 = 36;
TYPE
MSGTYPE = ARRAY 37 OF e.LSTRPTR;
CONST
MSGS = MSGTYPE(
SYS.ADR( "Out of memory" ),
SYS.ADR( "Can't open screen" ),
SYS.ADR( "Can't open window" ),
SYS.ADR( "Can't open file" ),
SYS.ADR( "Read/Write Error" ),
SYS.ADR( "Retry|Abort" ),
SYS.ADR( "File empty" ),
SYS.ADR( "Save" ),
SYS.ADR( "Use" ),
SYS.ADR( "Cancel" ),
SYS.ADR( " OK " ),
SYS.ADR( "Choose Screen Mode:"),
SYS.ADR( " File: %-30.30s %ld%% (%ld of %ld Bytes) %ld Lines"),
SYS.ADR( "\x13 \x15 MuchMore %s Commands: "),
SYS.ADR( " \x0dSpace\x05,\x0d LMB\x05: Start / Stop scrolling, Quit at end of file"),
SYS.ADR( " \x0dBackSpace\x05,\x0d RMB\x05: Start / Stop scrolling backwards"),
SYS.ADR( " \x0dUp\x05/\x0dDown\x05: Move one line \x0dup\x05 or \x0ddown\x05"),
SYS.ADR( " \x0dShift \x05+\x0d Up\x05/\x0dDn\x05: Start / Stop quick scrolling \x0dup\x05 or \x0ddown\x05"),
SYS.ADR( " \x0dControl\x05: Increase scroll speed"),
SYS.ADR( " \x0dAlt\x05+\x0dUp\x05/\x0dDn\x05,\x0d PgUp\x05/\x0dDn\x05: Move one page \x0dup\x05 or \x0ddown\x05"),
SYS.ADR( " \x0dT\x05,\x0d Home \x05/\x0d B\x05,\x0d End\x05: Goto \x0dt\x05op / \x0db\x05ottom of text"),
SYS.ADR( " (\x0DShift\x05) \x0DF\x05, \x0DN\x05, \x0DP\x05: \x0DF\x05ind string (case sensitive), \x0DN\x05ext, \x0DP\x05revious"),
SYS.ADR( " \x0dShift \x05+\x0d Fn\x05: Set textmarker #n to current position"),
SYS.ADR( " \x0dFn\x05: Goto marker #n or set marker #n if it wasn't set yet"),
SYS.ADR( " \x0dG\x05: \x0dG\x05oto line..."),
SYS.ADR( " \x0dNK 0\x05: Display info line"),
SYS.ADR( " \x0dShift \x05+\x0d Alt \x05+\x0d O\x05: Print text"),
SYS.ADR( " \x0dW\x05: \x0dW\x05rite block between marker #1 and #2 to file or prt"),
SYS.ADR( " \x0dL\x05: \x0dL\x05oad new text"),
SYS.ADR( " \x0dHELP\x05,\x0d H\x05: Show commands"),
SYS.ADR( " \x0dESC\x05,\x0d Q\x05,\x0d X\x05,\x0d NK 5\x05:\x0d Q\x05uit"),
SYS.ADR( "© \x131988-95 Fridtjof Siebert & Christian Stiens"),
SYS.ADR( ""),
SYS.ADR( " \x13Please refer to MuchMore.doc for a detailed copyright notice"),
SYS.ADR( " This is another product of the Amiga MODULA & OBERON Klub Stuttgart - \x0d\x13AMOK"),
SYS.ADR( " \x0dC\x05: \x0dC\x05opy block between marker #1 and #2 to clipboard"),
SYS.ADR( " \x0dShift \x05+\x0d Alt \x05+\x0d E\x05: \x0dE\x05dit text") );
TYPE BusyPointer = ARRAY 36 OF INTEGER;
CONST TheBusyPointer = BusyPointer(
00000U,00000U,
00400U,007C0U, 00000U,007C0U, 00100U,00380U, 00000U,007E0U,
007C0U,01FF8U, 01FF0U,03FECU, 03FF8U,07FDEU, 03FF8U,07FBEU,
07FFCU,0FF7FU, 07EFCU,0FFFFU, 07FFCU,0FFFFU, 03FF8U,07FFEU,
03FF8U,07FFEU, 01FF0U,03FFCU, 007C0U,01FF8U, 00000U,007E0U,
00000U,00000U);
CONST (* RawKey Codes: *)
ESC = 45H; HELP = 5FH;
UP = 4CH; DOWN = 4DH;
SPACE = 40H; BS = 41H;
CR = 44H; ENTER = 43H;
NK0 = 0FH; NK1 = 1DH; NK2 = 1EH; NK3 = 1FH;
NK5 = 2EH; NK7 = 3DH; NK8 = 3EH; NK9 = 3FH;
F1 = 50H; F10 = 59H;
CONST
ShowStackSize = 4096;
BufferSize = 2048;
w = TRUE;
f = FALSE;
MyIdcmp = LONGSET{I.rawKey,I.mouseButtons,I.closeWindow,I.activeWindow,I.inactiveWindow,I.newSize};
(* Control codes: *)
plain = 11X;
italic = 12X;
bold = 13X;
boldit = 14X;
ulineon = 15X;
ulineoff = 16X;
Italic = 0;
Bold = 1;
Ulin = 2;
Inv = 3;
TYPE
String = ARRAY 256 OF CHAR;
StringPtr = UNTRACED POINTER TO String;
CharPtr = UNTRACED POINTER TO CHAR;
LongPtr = UNTRACED POINTER TO LONGINT;
TextLinePtr = UNTRACED POINTER TO TextLine;
TextLine = STRUCT
prev : TextLinePtr;
next : TextLinePtr;
len : INTEGER;
size : INTEGER;
text : String;
END;
CONST
MaxLen = SIZE(String);
TYPE
WBStartupPtr = UNTRACED POINTER TO STRUCT (message : e.Message)
process : d.ProcessId;
segment : e.BPTR;
numArgs : LONGINT;
toolWindow : StringPtr;
argList : UNTRACED POINTER TO ARRAY 256 OF STRUCT
lock : d.FileLockPtr;
name : StringPtr;
END;
END;
DiskObjectPtr = UNTRACED POINTER TO STRUCT
magic : INTEGER;
version : INTEGER;
gadget : I.Gadget;
type : SHORTINT;
defaultTool: StringPtr;
toolTypes : e.APTR;
currentX : LONGINT;
currentY : LONGINT;
drawerData : e.APTR;
toolWindow : StringPtr;
stackSize : LONGINT;
END;
Args = STRUCT (dummy: d.ArgsStruct)
b : LongPtr;
c : StringPtr;
d : StringPtr;
e : StringPtr;
f : StringPtr;
i : StringPtr;
o : StringPtr;
p : LongPtr;
q : StringPtr;
s : LongPtr;
t : LongPtr;
u : StringPtr;
x : LongPtr;
w : StringPtr;
wl : LongPtr;
wt : LongPtr;
ww : LongPtr;
wh : LongPtr;
fw : LongPtr;
fh : LongPtr;
file : StringPtr;
END;
(*------ Memory: ------*)
CONST ChunkSize = 16384; (* size of allocated chunks *)
TYPE
MemChunkPtr = UNTRACED POINTER TO MemChunk; (* chunklist *)
MemChunk = STRUCT
prev: MemChunkPtr; (* link *)
data: ARRAY ChunkSize OF CHAR; (* ChunkSize Bytes of memory *)
END;
(*------ Globals ------*)
VAR
pub : I.ScreenPtr; (* default public screen *)
Screen : I.ScreenPtr; (* MuchMore's Screen *)
Window : I.WindowPtr; (* MuchMore's Window *)
rp : g.RastPortPtr; (* Screen's RastPort *)
BM : g.BitMapPtr; (* Screen's BitMap *)
id : LONGINT; (* Display ID *)
catalog : loc.CatalogPtr; (* The Catalog *)
MyFile : d.FileHandlePtr; (* For loading Textfile *)
MyAttr : g.TextAttr; (* The selected Font attributes *)
MyFont : g.TextFontPtr; (* The selected Font *)
OldFont : g.TextFontPtr; (* To save old Font *)
FontName : String; (* My Font Name or *)
FontSize : INTEGER; (* My Font Size *)
FirstLine : TextLinePtr; (* the topmost Line *)
TopLine : TextLinePtr; (* the topmost Line *)
BottomLine : TextLinePtr; (* Last Line displayed on Screen *)
LoadLine : TextLinePtr; (* currently loaded Line *)
LastLine : TextLinePtr; (* Last element of LineList *)
writeText : TextLine; (* temp. Text Line *)
Name,OldName : String; (* Text's Name *)
option : String; (* CLI Option *)
pubscreenname : String;
zoomBox : ARRAY 4 OF INTEGER;
editcmd : String;
Pens : String; (* Screen colors *)
Cols : ARRAY 4 OF INTEGER; (* Color array for LoadRGB4 *)
busyPointer : UNTRACED POINTER TO BusyPointer;
icon : DiskObjectPtr; (* info *)
nameptr : StringPtr; (* String Pointer *)
chptr : CharPtr; (* Char Pointer *)
PStr : String; (* The command for Dos.Execute *)
Buffer : UNTRACED POINTER TO ARRAY BufferSize OF CHAR; (* ReadBuf *)
RQPos : LONGINT; (* Position within ReadBuffer *)
RQLen : LONGINT; (* Number of CHARs in Buffer *)
AnzLines : LONGINT; (* Length of Text in Lines *)
NumLines : INTEGER; (* Number of Lines on Screen *)
fontWidth,fontHeight: INTEGER; (* Font size *)
fontBaseLine : INTEGER; (* Font base line *)
spacing : INTEGER; (* Extra Line Spacing *)
NumColumns : INTEGER; (* Number of Columns on Screen *)
PageHeight : INTEGER; (* fontHeight*NumLines *)
i,j : INTEGER; (* count *)
left,top : INTEGER; (* Dimensions of MMs window *)
width,height : INTEGER;
initialheight : INTEGER;
depth : INTEGER; (* Number of planes *)
ci : INTEGER; (* Color index *)
scrollmode : INTEGER; (* The scrollmode *)
taskpri,oldpri : SHORTINT; (* Muchmore's Task Priority *)
frwidth,frheight:INTEGER;
MyLock,OldDir : d.FileLockPtr; (* To Examine and Load File *)
oldcd : d.FileLockPtr; (* To save old CD *)
progdir : d.FileLockPtr; (* Lock on PROGDIR: *)
clock : d.FileLockPtr; (* Lock on C: *)
FileInfo : d.FileInfoBlockPtr; (* to get File's length *)
FileLength,TextLength : LONGINT; (* Length of File and Displayed Text *)
ReadLength : LONGINT; (* Length of Text while reading *)
ScreenPos : INTEGER; (* actual position within bitmap *)
ShowTask : e.TaskPtr; (* the task that displays the text *)
ShowStack : e.APTR; (* it's stack *)
ShowTaskRunning: BOOLEAN; (* is Showtask activated? *)
win : BOOLEAN; (* Is MM running in a window? *)
interleaved : BOOLEAN; (* Use interleaved Screen? *)
zoomed : BOOLEAN; (* Is MM iconified ? *)
stdin : BOOLEAN; (* Are we reading from STDIN ? *)
SignalNewData : BOOLEAN; (* Signal when new data is loaded *)
SignalAllRead : BOOLEAN; (* send signal at end of text *)
Done : BOOLEAN; (* Quit *)
print : BOOLEAN; (* print text? *)
save : BOOLEAN; (* save block? *)
copy : BOOLEAN; (* copy block to clipboard? *)
NewText : BOOLEAN; (* load new text *)
Info : BOOLEAN; (* is info currently displayed ? *)
modeReq : BOOLEAN; (* Show Display Mode Requester? *)
Scroll : BOOLEAN; (* scrolling or waiting? *)
Fast : BOOLEAN; (* scroll quick? *)
Sync : BOOLEAN; (* scroll very quick? *)
Decrunched : BOOLEAN; (* Is file decrunched? *)
Scrollable : BOOLEAN; (* is screen able to scroll? *)
refresh : BOOLEAN; (* Refresh Window? *)
oldstyle : BOOLEAN; (* Page Up/Down with soft scroll? *)
lace : BOOLEAN; (* Is screen interlaced? *)
cLocked : BOOLEAN; (* Is C: locked ? *)
NewDisp : BOOLEAN; (* need to rebuild Display ? *)
fastquit : BOOLEAN;
showTaskOk : BOOLEAN;
style : SHORTSET; (* Text style *)
mySig : LONGSET; (* My Signal Set *)
showSig : LONGSET; (* ShowTask's Signal Set *)
Me : d.ProcessPtr; (* my main task *)
meInt : LONGINT; (* for making unique filename *)
MyMsgPtr : I.IntuiMessagePtr; (* for receiving Messages *)
in,out : d.FileHandlePtr; (* i/o for TYPE xxx TO PRT: *)
mySigBit : INTEGER; (* My Signal Bit *)
showSigBit : INTEGER; (* ShowTask's Sig Bit *)
frame : INTEGER; (* Frame Count *)
fg,bg : INTEGER; (* Text colors *)
oldfg,oldbg : INTEGER; (* Old Text colors *)
tabw : INTEGER; (* Tabulator width *)
rd : d.RDArgsPtr; (* For ReadArgs *)
args : Args; (* My CLI Args *)
ArgPtr : StringPtr; (* to get WBArg *)
wbm : WBStartupPtr; (* WBenchMessage *)
ri : g.RasInfoPtr; (* Screen's ViewPort's RasInfo *)
dims : g.DimensionInfo; (* Dims for KS2.0 *)
disp : g.DisplayInfo; (* DisplayInfo for KS2.0 *)
StrGadget : I.Gadget; (* Gadget for Find-Command *)
StrInfo : I.StringInfo; (* its special info *)
StrExt : I.StringExtend; (* its extension *)
asl : e.LibraryPtr; (* ASL-librarybase *)
diskFontBase : e.LibraryPtr; (* DiskFont-LibraryBase *)
xpk : e.LibraryPtr; (* XpkMaster-Librarybase *)
iconBase : e.LibraryPtr; (* Icon-Librarybase *)
Filename : String; (* The Filename (without path) *)
Dirname : String; (* its path *)
Pattern : ARRAY 80 OF CHAR; (* The pattern for Filerequester *)
TextMarkers : ARRAY 10 OF TextLinePtr; (* Marked Positions in text *)
FindLine : TextLinePtr; (* Last found line *)
KeyMap : ARRAY 50H OF CHAR; (* console's KeyMap *)
Password : String; (* Password for encrypted texts *)
conreq : e.IOStdReqPtr; (* Console IO-Request *)
console : e.DevicePtr; (* the console.device *)
ievent : ie.InputEventPtr; (* InputEvent to convert keycodes *)
WriteName : String; (* File to write Block *)
savefrom,savesize: LONGINT; (* How much to save? *)
iff : ip.IFFHandlePtr; (* IFF Handle for clipboard copy *)
buffer : UNTRACED POINTER TO CHAR; (* Save buffer *)
MemIndex : INTEGER; (* index in current Chunk *)
CurChunk : MemChunkPtr; (* current chunk *)
c : CHAR; (* \ used by GetTextLine(); *)
le : INTEGER; (* / global for speed *)
(*-------------------------------------------------------------------------*)
PROCEDURE OpenDiskFont*{diskFontBase,-30}(VAR textAttr{8}: g.TextAttr): g.TextFontPtr;
PROCEDURE GetDiskObject {iconBase,- 78}(name{8} : ARRAY OF CHAR): DiskObjectPtr;
PROCEDURE FreeDiskObject{iconBase,- 90}(diskobj{8} : DiskObjectPtr);
PROCEDURE FindToolType {iconBase,- 96}(toolTypes{8} : e.APTR;
typeName{9} : ARRAY OF CHAR): StringPtr;
PROCEDURE MatchToolValue{iconBase,-102}(typeString{8} : ARRAY OF CHAR;
val{9} : ARRAY OF CHAR): BOOLEAN;
(*------------------------- ASL Stuff: ----------------------------------*)
CONST
aslTag = u.user + 80000H;
taghail = aslTag + 1;
window = aslTag + 2;
leftEdge = aslTag + 3;
topEdge = aslTag + 4;
tagWidth = aslTag + 5;
tagHeight = aslTag + 6;
hookFunc = aslTag + 7;
file = aslTag + 8;
dir = aslTag + 9;
pattern = aslTag + 10;
funcFlags = aslTag + 20;
screen = aslTag + 40;
sleepWindow=aslTag + 43;
fiDir = u.user + 50;
patGad = 0;
fileRequest = 0;
screenModeRequest = 2;
smPropertyFlags = aslTag+114;
smPropertyMask = aslTag+115;
titleText = aslTag+1;
initialDisplayID= aslTag+100;
TYPE
ASLRequesterPtr = UNTRACED POINTER TO ASLRequester;
ScreenModeRequesterPtr = UNTRACED POINTER TO ScreenModeRequester;
FileRequesterPtr = UNTRACED POINTER TO FileRequester;
ASLRequester = STRUCT END;
FileRequester = STRUCT (dummy: ASLRequester)
reserved0 : ARRAY 4 OF e.UBYTE;
file : e.STRPTR;
dir : e.STRPTR;
reserved1 : ARRAY 10 OF e.UBYTE;
leftEdge : INTEGER;
topEdge : INTEGER;
width : INTEGER;
height : INTEGER;
reserved2 : ARRAY 2 OF e.UBYTE;
numArgs : LONGINT;
argList : e.APTR;
userData : e.APTR;
reserved3 : ARRAY 8 OF e.UBYTE;
pat : e.STRPTR;
END;
ScreenModeRequester = STRUCT (dummy: ASLRequester)
displayID : LONGINT;
displayWidth : LONGINT;
displayHeight : LONGINT;
displayDepth : INTEGER;
overscanType : INTEGER;
autoScroll : BOOLEAN;
pad1 : SHORTINT;
bitMapWidth : LONGINT;
bitMapHeight : LONGINT;
leftEdge : INTEGER;
topEdge : INTEGER;
width : INTEGER;
height : INTEGER;
infoOpened : BOOLEAN;
pad2 : SHORTINT;
infoLeftEdge : INTEGER;
infoTopEdge : INTEGER;
infoWidth : INTEGER;
infoHeight : INTEGER;
userData : e.APTR;
END;
PROCEDURE AllocAslRequestTags{asl,- 48}(reqType{0}: LONGINT; tag1{8}.. : u.Tag): ASLRequesterPtr;
PROCEDURE FreeAslRequest {asl,- 54}(requester{8}: ASLRequesterPtr);
PROCEDURE AslRequestTags {asl,- 60}(requester{8}: ASLRequesterPtr; tag1{9}.. : u.Tag): BOOLEAN;
(*-------------------------------------------------------------------------*)
(* $Debug- *)
PROCEDURE StuffChar; (* $EntryExitCode- *)
BEGIN
SYS.INLINE(016C0U, 04E75U)
END StuffChar;
(*-------------------------------------------------------------------------*)
PROCEDURE LocStr (num: LONGINT): e.LSTRPTR;
VAR default: e.LSTRPTR;
BEGIN
default := MSGS[num];
IF loc.base=NIL THEN RETURN default
ELSE RETURN loc.GetCatalogStr(catalog,num,default^) END;
END LocStr;
(*----------------------------- Requester: ------------------------------*)
PROCEDURE Error(Text: ARRAY OF CHAR); (* $CopyArrays- *)
VAR es: I.EasyStruct;
BEGIN
IF ol.wbStarted THEN
es.structSize := SIZE(I.EasyStruct);
es.flags := LONGSET{};
es.title := SYS.ADR(MuchText);
es.textFormat := SYS.ADR(Text);
es.gadgetFormat := LocStr(MSGOK);
IF I.EasyRequest(NIL,SYS.ADR(es),NIL,NIL)=0 THEN END;
ELSE
SYS.SETREG(0,d.Write(d.Output(),Text,str.Length(Text)));
SYS.SETREG(0,d.Write(d.Output(),"\n",1));
END;
HALT(d.fail);
END Error;
PROCEDURE OutOfMemHandler;
VAR es: I.EasyStruct;
BEGIN
es.structSize := SIZE(I.EasyStruct);
es.flags := LONGSET{};
es.title := SYS.ADR(MuchText);
es.textFormat := LocStr(MSGOOM);
es.gadgetFormat := LocStr(MSGRETRYABORT);
IF I.EasyRequest(NIL,SYS.ADR(es),NIL,NIL)=0 THEN
HALT(d.fail)
END;
END OutOfMemHandler;
(*-------------------------------------------------------------------------*)
PROCEDURE AllocLine(sz: INTEGER): TextLinePtr;
VAR newchunk: MemChunkPtr;
BEGIN
INC(sz,SIZE(TextLine)-MaxLen); IF ODD(sz) THEN INC(sz) END;
IF MemIndex+sz<=ChunkSize THEN (* does mem fit into current chunk ? *)
INC(MemIndex,sz); (* increment index in current chunk *)
ELSE
NEW(newchunk); (* allocate new chunk *)
newchunk.prev := CurChunk; (* link chunk into list *)
CurChunk := newchunk;
MemIndex := sz;
END;
RETURN SYS.ADR(CurChunk.data[MemIndex-sz]);
END AllocLine;
PROCEDURE DisposeLines();
VAR chunk: MemChunkPtr;
BEGIN
WHILE CurChunk#NIL DO
chunk := CurChunk.prev;
DISPOSE(CurChunk);
CurChunk := chunk;
END;
MemIndex := ChunkSize;
END DisposeLines;
(*-------------------------------------------------------------------------*)
PROCEDURE Busy;
BEGIN
IF Window # NIL THEN
I.OldModifyIDCMP(Window,MyIdcmp-LONGSET{I.rawKey,I.mouseButtons});
IF I.base.libNode.version >= 39 THEN
I.SetWindowPointer(Window,I.waBusyPointer,I.LTRUE,u.done);
ELSE
I.SetPointer(Window,busyPointer^,16,16,-6,0);
END;
END;
END Busy;
PROCEDURE UnBusy;
BEGIN
IF Window # NIL THEN
IF I.base.libNode.version >= 39 THEN
I.SetWindowPointer(Window,u.done);
ELSE
I.ClearPointer(Window);
END;
I.OldModifyIDCMP(Window,MyIdcmp);
END;
END UnBusy;
(*------ Scroll: ------*)
PROCEDURE ScrollDisplay (sync,fast,always: BOOLEAN);
VAR m: INTEGER;
BEGIN
IF Scrollable THEN
m := 1;
IF ~always THEN
IF lace & ~fast THEN m := 2 END;
IF ~sync THEN INC(m,m*2) END;
END;
IF (m=1) OR (frame MOD m=0) THEN
CASE scrollmode OF
| 1: g.ScrollVPort(SYS.ADR(Screen.viewPort));
g.WaitTOF;
| 2: I.OldMakeScreen(Screen);
I.OldRethinkDisplay();
(* 3: ScrollRaster *)
| 4: g.WaitTOF;
g.ScrollVPort(SYS.ADR(Screen.viewPort));
| 5: g.ScrollVPort(SYS.ADR(Screen.viewPort));
g.WaitBOVP(SYS.ADR(Screen.viewPort));
ELSE (* 0: *)
I.OldMakeScreen(Screen);
e.Forbid; SYS.SETREG(0,g.MrgCop(I.ViewAddress())); e.Permit;
g.WaitTOF;
END;
END;
(* $OvflChk- *)
INC(frame);
(* $OvflChk= *)
END;
END ScrollDisplay;
(*------ Clear Display: ------*)
PROCEDURE ClearDisplay;
BEGIN
IF win THEN
g.SetAPen(rp,0);
g.RectFill(rp,left,top,left+width-1,top+height-1);
ELSE
g.SetRast(rp,0);
END;
IF Scrollable THEN
ri.ryOffset := 0;
ScreenPos := 0;
ScrollDisplay(f,f,w);
END;
END ClearDisplay;
(*-------------------------------------------------------------------------*)
(*------ Read one TextLine into a Variable: ------*)
PROCEDURE GetTextLine(): TextLinePtr;
(* returns NIL at EOF *)
VAR
l : TextLinePtr;
sz,wd,i,j: INTEGER;
cnt : INTEGER;
txt : ARRAY MaxLen+1 OF CHAR;
num : ARRAY 10 OF INTEGER;
newcol : BOOLEAN;
oldstyle : SHORTSET;
PROCEDURE GetCh();
BEGIN
IF RQPos=RQLen THEN
RQLen := d.Read(MyFile,Buffer^,BufferSize);
IF RQLen<0 THEN Error(LocStr(MSGRWERR)^) END;
RQPos := 0;
END;
IF RQLen=0 THEN
c := 0X
ELSE
c := Buffer[RQPos];
IF c=0X THEN c:=1X END;
INC(RQPos); INC(le);
END;
END GetCh;
BEGIN
IF RQLen=0 THEN RETURN NIL END;
sz := 0; wd := 0; le := 0; cnt := 0;
IF Italic IN style THEN IF Bold IN style THEN txt[sz] := boldit ELSE txt[sz] := italic END; INC(sz)
ELSE IF Bold IN style THEN txt[sz] := bold; INC(sz) END END;
IF Ulin IN style THEN txt[sz] := ulineon; INC(sz) END;
IF Inv IN style THEN txt[sz] := CHR(fg+4*bg+1); INC(sz)
ELSIF (fg#1) OR (bg#0) THEN txt[sz] := CHR(bg+4*fg+1); INC(sz) END;
LOOP
LOOP
GetCh;
IF (c#1BX) & (c#9BX) THEN EXIT END;
i := -1;
REPEAT
GetCh;
IF (c>="0") & (c<="9") THEN
INC(i); num[i] := 0;
REPEAT
num[i] := 10*num[i]+(ORD(c)-ORD("0")); GetCh;
UNTIL (c<"0") OR (c>"9");
END;
c := CAP(c);
UNTIL (c>="?") & (c<="Z") OR (c=0X) OR (i=9);
IF c="M" THEN
newcol := f; oldstyle := style; j := 0;
IF i=-1 THEN i:=0; num[0] := 0 END;
WHILE (i>=j) & (sz<MaxLen-1) DO
CASE num[j] OF
0: style := SHORTSET{}; fg := 1; bg := 0; newcol := w |
1: INCL(style,Bold) |
2: fg := 2; newcol := w |
3: INCL(style,Italic) |
4: INCL(style,Ulin) |
7: INCL(style,Inv); newcol := w |
8: oldfg:=fg; oldbg:=bg; fg:=0; bg:=0; newcol := w |
22: EXCL(style,Bold); fg := 1; newcol := w |
23: EXCL(style,Italic) |
24: EXCL(style,Ulin) |
27: EXCL(style,Inv); newcol := w |
28: fg:=oldfg; bg:=oldbg; newcol := w |
30..37: fg := (num[j]-30) MOD 4; newcol := w |
39: fg := 1; newcol := w |
40..47: bg := (num[j]-40) MOD 4; newcol := w |
49: bg := 0; newcol := w |
ELSE END;
INC(j);
END;
IF (oldstyle#style) & (sz<MaxLen) THEN
IF Italic IN style THEN IF Bold IN style THEN txt[sz] := boldit ELSE txt[sz] := italic END;
ELSE IF Bold IN style THEN txt[sz] := bold ELSE txt[sz] := plain END;
END;
INC(sz);
IF (Ulin IN style) THEN
IF ~((Ulin IN oldstyle)) & (sz<MaxLen) THEN
txt[sz] := ulineon;
INC(sz);
END;
ELSE
IF (Ulin IN oldstyle) & (sz<MaxLen) THEN
txt[sz] := ulineoff;
INC(sz);
END;
END;
END;
IF newcol & (sz<MaxLen) THEN
IF Inv IN style THEN txt[sz] := CHR(fg+4*bg+1)
ELSE txt[sz] := CHR(bg+4*fg+1) END;
INC(sz);
END;
END; (* IF c="m" THEN *)
END; (* LOOP *)
CASE c OF
(*
020X.. 7FX: txt[sz] := c; INC(sz); INC(wd) |
0A1X..0FFX: txt[sz] := c; INC(sz); INC(wd) |
*)
020X.. 0FFX: txt[sz] := c; INC(sz); INC(wd) |
8X: (* BS *) IF wd>0 THEN DEC(sz); DEC(wd); END |
9X: (* TAB *) REPEAT
txt[sz] := 20X; INC(sz); INC(wd)
UNTIL (sz=MaxLen) OR (wd=NumColumns) OR (sz MOD tabw=0) |
(*0A0X: txt[sz] := 20X; INC(sz); INC(wd) |*)
0X,0AX,0CX: EXIT
ELSE
END;
IF (wd>=NumColumns) OR (sz>=MaxLen) THEN EXIT END;
END;
txt[sz] := 0X; INC(sz);
l := AllocLine(sz);
l.len := le; l.size:= sz;
WHILE sz>0 DO DEC(sz); l.text[sz] := txt[sz] END;
INC(ReadLength,le);
RETURN l;
END GetTextLine;
(*------ Write Line to Screen: ------*)
PROCEDURE Type (pos: INTEGER; line: TextLinePtr);
VAR
style: SHORTSET;
front,back: SHORTINT;
c: CHAR;
last,i,x,y: INTEGER;
strPtr: StringPtr;
BEGIN
g.SetDrMd(rp,g.jam2);
IF Scrollable THEN
g.SetAPen(rp,0);
y := pos * fontHeight;
IF ~refresh THEN g.RectFill(rp,0,y,width-1,y+fontHeight-spacing-1) END;
END;
i := 0; x := 0; style := SHORTSET{}; front := 1; back := 0;
LOOP
WHILE line.text[i] < " " DO
c := line.text[i];
IF c=0X THEN EXIT END;
CASE c OF
plain : style := style - SHORTSET{g.bold,g.italic} |
italic : EXCL(style,g.bold); INCL(style,g.italic) |
bold : INCL(style,g.bold); EXCL(style,g.italic) |
boldit : style := style + SHORTSET{g.bold,g.italic} |
ulineon : INCL(style,g.underlined) |
ulineoff: EXCL(style,g.underlined) |
1X..10X : DEC(c);
front := SHORT(ORD(c)) DIV 4;
back := SHORT(ORD(c)) MOD 4 |
ELSE END;
INC(i);
END;
strPtr := SYS.ADR(line.text[i]); last := i;
REPEAT INC(i) UNTIL line.text[i]<" ";
SYS.SETREG(0,g.SetSoftStyle(rp,style,-SHORTSET{}));
g.SetAPen(rp,front);
g.SetBPen(rp,back);
g.Move(rp,left+fontWidth*x,top+fontHeight*pos+fontBaseLine);
g.Text(rp,strPtr^,i-last);
INC(x,i-last);
END;
END Type;
PROCEDURE CopyScrollLine(pos: INTEGER);
(* Kopiert die an pos geschriebene Zeile auf den entsprechenden
* DoubleBuffer-Bereich
* ACHTUNG: Darf nur aufgerufen werden, wenn Scrollable TRUE ist!
*)
VAR
y,z: INTEGER;
BEGIN
y := pos*fontHeight;
z := PageHeight;
IF pos >= NumLines THEN z := -z END;
SYS.SETREG(0,g.BltBitMap(BM, 0,y, BM, 0,y+z, width,fontHeight, 0C0X, SHORTSET{0..7}, NIL));
END CopyScrollLine;
(*------ Copy String to TextLine: ------*)
PROCEDURE CopyToWriteText (String: StringPtr);
VAR i,j : INTEGER;
BEGIN
e.CopyMem(String^,writeText.text,MaxLen-1);
j := 0;
FOR i := 0 TO SHORT(str.Length(writeText.text))-1 DO
IF writeText.text[i] >= " " THEN INC(j) END;
IF j >= NumColumns THEN
writeText.text[i] := 0X;
RETURN
END;
END;
END CopyToWriteText;
(*------ Write String to Screen (at any position): ------*)
PROCEDURE TypeTo (VAR text: TextLine; pos: INTEGER);
BEGIN
IF pos < NumLines THEN
IF Scrollable THEN
INC(pos,ScreenPos);
Type(pos,SYS.ADR(text));
CopyScrollLine(pos);
ELSE
Type(pos,SYS.ADR(text));
END;
END;
END TypeTo;
(*------ Write String to Screen (at any position): ------*)
PROCEDURE WriteTo (String: StringPtr; pos: INTEGER);
BEGIN
CopyToWriteText(String);
TypeTo(writeText,pos);
END WriteTo;
(*------ Write Line at Bottom of Text: ------*)
PROCEDURE AddBottomLine (Line: TextLinePtr; Fast: BOOLEAN);
VAR i,y: INTEGER;
BEGIN
IF ~Scrollable THEN
g.SetAPen(rp,0); g.SetBPen(rp,0);
IF Fast THEN
g.ScrollRaster(rp,0,fontHeight,left,top,left+width-1,top+height-1);
IF Sync THEN g.WaitTOF END;
ELSE
i := fontHeight;
REPEAT
IF Window.height=initialheight THEN (* Prevent crash under v37 *)
g.ScrollRaster(rp,0,1,left,top,left+width-1,top+height-1);
END;
IF Sync THEN g.WaitTOF END;
DEC(i);
UNTIL i=0;
END;
Type(NumLines-1,Line);
ELSE
Type(ScreenPos+NumLines,Line);
y := ScreenPos*fontHeight;
IF Fast THEN
INC(ri.ryOffset,fontHeight);
ScrollDisplay(Sync,w,f);
SYS.SETREG(0,g.BltBitMap(BM, 0,y+PageHeight, BM, 0,y, width,fontHeight, 0C0X, SHORTSET{0..7}, NIL));
ELSE
i := fontHeight;
REPEAT
INC(ri.ryOffset);
ScrollDisplay(Sync,f,f);
SYS.SETREG(0,g.BltBitMap(BM, 0,y+PageHeight, BM, 0,y, width,1, 0C0X, SHORTSET{0..7}, NIL));
INC(y);
DEC(i);
UNTIL i=0;
END;
INC(ScreenPos);
IF ScreenPos=NumLines THEN
ScreenPos := 0;
ri.ryOffset := 0;
END;
END;
END AddBottomLine;
(*------ Check whether BottomLine.next is NIL or not: ------*)
PROCEDURE TryBottomnext(): BOOLEAN;
(* returns TRUE if BottomLine.next#NIL END; *)
BEGIN
IF (BottomLine.next=NIL) & (MyFile#NIL) THEN
SignalNewData := w;
SYS.SETREG(0,e.Wait(showSig));
SignalNewData := f;
END;
RETURN BottomLine.next#NIL;
END TryBottomnext;
(*------ Scroll down one Line: ------*)
PROCEDURE ScrollDown(Fast: BOOLEAN);
BEGIN
IF TryBottomnext() THEN
BottomLine := BottomLine.next;
INC(AnzLines);
INC(TextLength,BottomLine.len);
ELSE RETURN END;
IF AnzLines >= NumLines THEN TopLine := TopLine.next END;
AddBottomLine(BottomLine,Fast);
END ScrollDown;
(*------ Scroll Up one Line: ------*)
PROCEDURE ScrUp (Fast: BOOLEAN);
VAR
i,y: INTEGER;
BEGIN
IF ~Scrollable THEN
g.SetAPen(rp,0); g.SetBPen(rp,0);
IF Fast THEN
g.ScrollRaster(rp,0,-fontHeight,left,top,left+width-1,top+height-1);
IF Sync THEN g.WaitTOF END;
ELSE
i := fontHeight;
REPEAT
IF Window.height=initialheight THEN
g.ScrollRaster(rp,0,-1,left,top,left+width-1,top+height-1);
END;
IF Sync THEN g.WaitTOF END;
DEC(i)
UNTIL i=0;
END;
IF TopLine.prev#NIL THEN Type(0,TopLine.prev) ELSE Type(0,FirstLine) END;
ELSE
IF ScreenPos=0 THEN
ri.ryOffset := NumLines*fontHeight;
ScreenPos := NumLines;
END;
DEC(ScreenPos);
IF TopLine.prev#NIL THEN Type(ScreenPos,TopLine.prev) ELSE Type(ScreenPos,FirstLine) END;
y := ScreenPos*fontHeight;
IF Fast THEN
DEC(ri.ryOffset,fontHeight);
ScrollDisplay(Sync,w,f);
SYS.SETREG(0,g.BltBitMap(BM, 0,y, BM, 0,y+PageHeight, width,fontHeight , 0C0X, SHORTSET{0..7}, NIL));
ELSE
INC(y,fontHeight);
i := fontHeight;
REPEAT
DEC(ri.ryOffset);
ScrollDisplay(Sync,f,f);
DEC(y);
SYS.SETREG(0,g.BltBitMap(BM, 0,y, BM, 0,y+PageHeight, width,1, 0C0X, SHORTSET{0..7}, NIL));
DEC(i);
UNTIL i=0;
END;
END;
END ScrUp;
PROCEDURE ScrollUp (Fast: BOOLEAN);
BEGIN
IF (TopLine.prev#NIL) & (TopLine.prev.prev#NIL) THEN
TopLine := TopLine.prev;
DEC(TextLength,BottomLine.len);
DEC(AnzLines);
BottomLine := BottomLine.prev;
ScrUp(Fast);
END;
END ScrollUp;
(*------ Undo last AddBottomLine: ------*)
PROCEDURE DelLine (Fast: BOOLEAN);
BEGIN
ScrUp(Fast);
Info := f;
END DelLine;
(*------ Convert String to Integer: ------*)
PROCEDURE StrToInt (str: StringPtr; base: INTEGER): LONGINT;
VAR
i,j: INTEGER;
num: LONGINT;
ch : CHAR;
neg: BOOLEAN;
BEGIN
num := 0; i := 0; neg := f;
IF str^[0] = '-' THEN str:=SYS.ADR(str[1]); neg := w END;
IF str^[0] = '$' THEN str:=SYS.ADR(str[1]); base:=16 END;
IF (str^[0]='0')&(CAP(str^[1])='X') THEN str:=SYS.ADR(str[2]); base:=16 END;
LOOP
IF i=LEN(str^) THEN EXIT END;
ch := CAP(str^[i]);
IF ch=0X THEN EXIT END;
j := ORD(ch);
CASE ch OF
"0".."9": DEC(j,ORD('0')) |
"A".."F": DEC(j,ORD('A')-10);
IF base=10 THEN base:=16; i:=-1; j:=0; num:=0 END;
ELSE EXIT
END;
num := num * base + j;
INC(i);
END;
IF neg THEN num := -num END;
RETURN num
END StrToInt;
(*-------------------------------------------------------------------------*)
PROCEDURE GetLength (t: TextLinePtr);
BEGIN
TextLength := 0; AnzLines := 0;
WHILE t#NIL DO INC(AnzLines); INC(TextLength,t.len); t := t.prev END;
END GetLength;
(*-------------------------------------------------------------------------*)
PROCEDURE NewDisplay;
(* Zeichnet ab BottomLine neu *)
VAR
i: INTEGER;
l: TextLinePtr;
BEGIN
IF ~refresh THEN ClearDisplay END;
l := BottomLine.prev;
IF l#NIL THEN BottomLine := l END;
l := BottomLine;
i := NumLines-1;
WHILE (i>0) & TryBottomnext() DO
BottomLine := BottomLine.next;
DEC(i);
END;
WHILE (i>0) & (l.prev#NIL) DO
l := l.prev;
DEC(i);
END;
TopLine := l.next;
WHILE i<NumLines DO
BottomLine := l;
TypeTo(BottomLine^,i);
INC(i);
l := l.next;
END;
GetLength(BottomLine);
Scroll := f;
Info := f;
END NewDisplay;
(*-------------------------------------------------------------------------*)
PROCEDURE GetString (VAR str: ARRAY OF CHAR; int,newdisp,hide: BOOLEAN);
VAR
Win: I.WindowPtr;
msg: I.IntuiMessagePtr;
class: LONGSET;
l,t,w,h: INTEGER;
screen: I.ScreenPtr;
BEGIN
ScrollDisplay(f,f,TRUE);
Busy;
screen := Screen;
w := width DIV 4 * 3;
l := (width-w) DIV 2;
t := height DIV 2;
IF Screen # NIL THEN
IF Scrollable THEN INC(t,ri.ryOffset) END;
h := Screen.font.ySize+4;
ELSE
screen := Window.wScreen;
INC(l,Window.leftEdge);
INC(t,Window.topEdge);
h := screen.font.ySize+4;
END;
StrGadget.leftEdge := 4;
StrGadget.topEdge := 2;
StrGadget.width := w-8;
StrGadget.height := h-4;
StrGadget.activation := {I.stringCenter,I.relVerify};
IF int THEN INCL(StrGadget.activation,I.longint) END;
StrGadget.flags := {};
StrGadget.gadgetType := I.strGadget;
StrGadget.specialInfo:= SYS.ADR(StrInfo);
StrInfo.buffer := SYS.ADR(str);
StrInfo.maxChars := SHORT(LEN(str))-1;
StrInfo.extension := SYS.ADR(StrExt);
IF hide THEN INCL(StrGadget.flags,I.stringExtend) END;
IF Scrollable THEN Screen.height := Screen.height * 2 END;
Win := I.OpenWindowTagsA(NIL,
I.waLeft, l,
I.waTop, t,
I.waWidth, w,
I.waHeight,h,
I.waIDCMP, LONGSET{I.gadgetUp,I.activeWindow,I.inactiveWindow},
I.waFlags, LONGSET{I.rmbTrap,I.activate,I.noCareRefresh},
I.waGadgets,SYS.ADR(StrGadget),
I.waCustomScreen,screen,
u.done);
IF Scrollable THEN Screen.height := Screen.height DIV 2 END;
IF Win # NIL THEN
e.WaitPort(Win.userPort);
SYS.SETREG(0,I.ActivateGadget(StrGadget,Win,NIL));
LOOP
e.WaitPort(Win.userPort);
msg := e.GetMsg(Win.userPort);
IF msg # NIL THEN
class := msg.class;
e.ReplyMsg(msg);
IF (I.gadgetUp IN class) OR (I.inactiveWindow IN class) THEN
EXIT
END;
END;
END;
I.CloseWindow(Win); Win := NIL;
END;
UnBusy;
IF newdisp & ~win THEN
refresh := TRUE; BottomLine := TopLine; NewDisplay; refresh := f;
END;
END GetString;
(*-------------------------------------------------------------------------*)
PROCEDURE * ShowProc;
VAR
l : TextLinePtr;
Down : BOOLEAN; (* Scroll-Direction *)
Shift : BOOLEAN; (* Shifted Keystroke ? *)
Alt : BOOLEAN; (* Altered Keystroke ? *)
wasInfo : BOOLEAN; (* was Info line displayed ? *)
found : BOOLEAN; (* TRUE, if find was successful *)
chr : CHAR; (* converted keycode *)
caseDelta : SHORTINT; (* Case sensitive Search? *)
flen : INTEGER; (* length of findstring *)
i,j : INTEGER; (* Count *)
Class : LONGSET; (* contains Message.class *)
Code : INTEGER; (* contains Message.code *)
Qualifier : SET; (* contains Message.qualifier *)
Find,FindStr: ARRAY 80 OF CHAR; (* findstring / capital findstring *)
Goto : ARRAY 10 OF CHAR; (* string containing goto line # *)
li : LONGINT; (* longint value of line to go to *)
HiText : TextLine; (* Highlited textline *)
OldHiText : TextLinePtr; (* original, un-hilited text *)
skipTab : ARRAY 256 OF INTEGER;(* for Boyer-Moore Alg. *)
PROCEDURE WaitAllRead();
BEGIN
IF MyFile # NIL THEN
Busy;
SignalAllRead := w;
SYS.SETREG(0,e.Wait(showSig));
SignalAllRead := f;
UnBusy;
END;
END WaitAllRead;
PROCEDURE HiLite(at,len: INTEGER);
(* Hilites len chars of BottomLine.text starting at position at *)
VAR
c: INTEGER;
col: CHAR;
BEGIN
OldHiText := BottomLine; HiText := OldHiText^; BottomLine := SYS.ADR(HiText);
IF at+len+2<MaxLen THEN
c := 0; col := 5X;
WHILE c<at DO
IF HiText.text[c]<CHR(17) THEN col := HiText.text[c] END;
INC(c);
END;
HiText.text[at] := CHR(17-ORD(col));
c := at; INC(len,at);
WHILE c<len DO
HiText.text[c+1] := OldHiText.text[c];
INC(c);
END;
HiText.text[c+1] := col;
REPEAT
HiText.text[c+2] := OldHiText.text[c];
INC(c);
UNTIL HiText.text[c-1]=0X;
END;
IF HiText.next#NIL THEN HiText.next.prev := SYS.ADR(HiText) END;
IF HiText.prev#NIL THEN HiText.prev.next := SYS.ADR(HiText) END;
END HiLite;
PROCEDURE UnHiLite();
BEGIN
IF HiText.next#NIL THEN HiText.next.prev := OldHiText END;
IF HiText.prev#NIL THEN HiText.prev.next := OldHiText END;
END UnHiLite;
PROCEDURE CalcSkipTab; (* Make skip-table for Boyer-Moore Alg. *)
VAR i,j: INTEGER;
BEGIN
FOR i := 0 TO 255 DO skipTab[i] := flen END;
i := 0;
FOR j := flen-1 TO 0 BY -1 DO
IF skipTab[ORD(FindStr[j])] = flen THEN
skipTab[ORD(FindStr[j])] := i;
END;
INC(i);
END;
END CalcSkipTab;
PROCEDURE Search(): BOOLEAN;
(* Searches string and hilites it if found. Result is TRUE if string found *)
VAR ch: CHAR;
i,j,t: INTEGER;
BEGIN
IF flen > BottomLine.size THEN RETURN f END;
i := flen-1;
FOR j := flen-1 TO 0 BY -1 DO
LOOP
ch := BottomLine.text[i];
CASE ch OF "a".."z","à".."ö","ø".."þ": DEC(ch,caseDelta) ELSE END;
IF ch = FindStr[j] THEN EXIT END;
t := skipTab[ORD(ch)];
IF flen-j > t THEN INC(i,flen-j) ELSE INC(i,t) END;
IF i >= BottomLine.size THEN RETURN f END;
j := flen-1;
END;
DEC(i);
END;
INC(i); IF i<0 THEN RETURN f END;
SYS.SETREG(0,TryBottomnext());
FindLine := BottomLine;
HiLite(i,flen);
found := w; RETURN w;
END Search;
PROCEDURE ShowInfo(Fast: BOOLEAN);
VAR IStr : String;
fmt : e.LSTRPTR;
i : INTEGER;
data : STRUCT name : e.STRPTR;
perc : LONGINT;
tlen : LONGINT;
flen : LONGINT;
lins : LONGINT;
END;
BEGIN
data.name := SYS.ADR(OldName);
data.tlen := TextLength;
data.flen := FileLength;
IF data.flen=0 THEN data.flen := ReadLength END;
IF data.flen=0 THEN data.flen := 1 END;
data.perc := TextLength * 100 DIV data.flen;
data.lins := AnzLines-1;
fmt := LocStr(MSGINFOFMT);
e.OldRawDoFmt(fmt^,SYS.ADR(data),StuffChar,SYS.ADR(IStr));
IStr[0] := 7X; IF depth<2 THEN IStr[0] := 2X END;
i := SHORT(str.Length(IStr));
REPEAT IStr[i] := 20X; INC(i) UNTIL (i>=LEN(IStr)-2) OR (i>=NumColumns+2);
IStr[i] := 0X;
CopyToWriteText(SYS.ADR(IStr));
AddBottomLine(SYS.ADR(writeText),Fast);
Info := w;
Scroll := f;
END ShowInfo;
PROCEDURE Help; (* executed when HELP or H is pressed *)
CONST
num = 25;
VAR
i,j : INTEGER;
help : ARRAY num OF e.LSTRPTR;
fmt : e.LSTRPTR;
data : StringPtr;
h1 : String;
BEGIN
data := SYS.ADR(Version);
fmt := LocStr(MSGH1);
e.OldRawDoFmt(fmt^,SYS.ADR(data),StuffChar,SYS.ADR(h1));
help[ 0] := SYS.ADR(h1);
help[ 1] := SYS.ADR("");
help[ 2] := LocStr(MSGH2);
help[ 3] := LocStr(MSGH3);
help[ 4] := LocStr(MSGH4);
help[ 5] := LocStr(MSGH5);
help[ 6] := LocStr(MSGH6);
help[ 7] := LocStr(MSGH7);
help[ 8] := LocStr(MSGH8);
help[ 9] := LocStr(MSGH9);
help[10] := LocStr(MSGH10);
help[11] := LocStr(MSGH11);
help[12] := LocStr(MSGH12);
help[13] := LocStr(MSGH13);
help[14] := LocStr(MSGH24);
help[15] := LocStr(MSGH14);
help[16] := LocStr(MSGH23);
help[17] := LocStr(MSGH15);
help[18] := LocStr(MSGH16);
help[19] := LocStr(MSGH17);
help[20] := LocStr(MSGH18);
help[21] := SYS.ADR("");
help[22] := LocStr(MSGH19);
help[23] := LocStr(MSGH21);
help[24] := LocStr(MSGH22);
ClearDisplay();
j := (NumLines - num) DIV 2; IF j<0 THEN j:=0 END;
i := 0;
WHILE (i<num) & (i+j<NumLines) DO
WriteTo(SYS.VAL(StringPtr,help[i]),j+i);
INC(i);
END;
LOOP
e.WaitPort(Window.userPort);
MyMsgPtr := e.GetMsg(Window.userPort);
IF (LONGSET{I.rawKey,I.mouseButtons}*MyMsgPtr.class#LONGSET{}) & (MyMsgPtr.code<128) THEN EXIT END;
e.ReplyMsg(MyMsgPtr);
END;
e.ReplyMsg(MyMsgPtr);
BottomLine := TopLine;
NewDisplay
END Help;
PROCEDURE Bottom; (* executed when END or B is pressed *)
BEGIN
WaitAllRead;
BottomLine := LastLine;
NewDisplay
END Bottom;
PROCEDURE Space(): BOOLEAN; (* executed if space or LMB is pressed *)
(* IF result=w THEN EXIT END *)
BEGIN
IF (MyFile=NIL) & (BottomLine.next=NIL) THEN (* End of file? *)
IF wasInfo THEN RETURN w END;
ShowInfo(Shift);
ELSE
IF Down THEN
Scroll := ~Scroll;
IF ~Scroll THEN ShowInfo(Fast) END;
ELSE
Down := w;
Scroll := w;
END;
Fast := Shift;
END;
RETURN f;
END Space;
PROCEDURE BackSpace; (* executed if backspace or RMB is pressed *)
BEGIN
Fast := Shift;
Scroll := Down OR ~Scroll;
Down := f
END BackSpace;
BEGIN
(* $IF SmallData *)
SYS.SETREG(13,e.AbsExecBase.thisTask.userData);
(* $END *)
(* $IFNOT ClearVars *)
Find[0] := 0X; FindStr[0] := 0X; Goto[0] := 0X;
(* $END *)
Down := w;
IF e.AllocSignal(Window.userPort.sigBit) >= 0 THEN
showTaskOk := w;
Window.userPort.sigTask := e.FindTask(NIL);
END;
showSigBit := e.AllocSignal(-1);
IF showSigBit >= 0 THEN showSig := LONGSET{showSigBit};
ELSE showTaskOk := f; showSig := LONGSET{} END;
e.Signal(Me,mySig);
SYS.SETREG(0,e.Wait(showSig));
LOOP
IF NewDisp THEN NewDisp := f; NewDisplay END;
(*------ Type Text: ------*)
LOOP
IF Scroll THEN
IF Down THEN
ScrollDown(Fast);
Scroll := (MyFile#NIL) OR (BottomLine.next#NIL);
ELSE
ScrollUp(Fast);
Scroll := (TopLine.prev#NIL) & (TopLine.prev.prev#NIL);
END;
ELSE
ScrollDisplay(f,f,w);
e.WaitPort(Window.userPort);
END;
MyMsgPtr := e.GetMsg(Window.userPort);
IF MyMsgPtr # NIL THEN
IF ~(I.inactiveWindow IN MyMsgPtr.class) THEN EXIT END;
e.ReplyMsg(MyMsgPtr);
I.OldModifyIDCMP(Window,MyIdcmp-LONGSET{I.mouseButtons});
e.WaitPort(Window.userPort);
I.OldModifyIDCMP(Window,MyIdcmp);
END;
END;
Code := MyMsgPtr.code;
Class := MyMsgPtr.class;
Qualifier := MyMsgPtr.qualifier;
e.ReplyMsg(MyMsgPtr);
Shift := {ie.lShift,ie.rShift,ie.capsLock} * Qualifier # {};
Alt := {ie.lAlt ,ie.rAlt} * Qualifier # {};
Sync := ~ (ie.control IN Qualifier);
IF ~Sync THEN Shift := w END;
IF ((I.rawKey IN Class) & (Code<80H)) OR
((I.mouseButtons IN Class) & ({ie.leftButton,ie.rightButton}*Qualifier#{}))
THEN
wasInfo := f;
IF Info THEN DelLine(Shift); wasInfo := w; END;
END;
IF I.mouseButtons IN Class THEN
IF (ie.leftButton IN Qualifier) & Space() THEN EXIT
ELSIF ie.rightButton IN Qualifier THEN BackSpace END;
ELSIF I.closeWindow IN Class THEN
EXIT;
ELSIF (I.newSize IN Class) THEN
Scroll := f;
zoomed := w;
IF Window.height = initialheight THEN
zoomed := f;
BottomLine := TopLine;
NewDisplay;
END;
ELSIF (I.rawKey IN Class) & (Code<80H) & ~zoomed THEN
CASE Code OF
| SPACE: IF Space() THEN EXIT END (* Space *)
| BS: BackSpace (* BackSpace *)
| DOWN,NK2,NK3: (* Down *)
IF (MyFile=NIL) & (BottomLine.next=NIL) THEN
I.DisplayBeep(NIL)
ELSE
IF Shift & (Code # NK3) THEN
Scroll := ~Down OR ~Scroll OR ~Fast;
Fast := w; Down := w;
ELSE
IF Alt OR (Code=NK3) THEN
IF oldstyle THEN
i := NumLines-1;
REPEAT
ScrollDown(w);
DEC(i);
UNTIL i=0;
ELSE
IF BottomLine.next#NIL THEN BottomLine := BottomLine.next END;
NewDisplay;
END;
ELSE
ScrollDown(w);
END;
Scroll := f;
END;
END;
| UP,NK8,NK9: (* Up *)
IF (TopLine.prev=NIL) OR (TopLine.prev.prev=NIL) THEN
I.DisplayBeep(NIL)
ELSE
IF Shift & (Code # NK9) THEN
Scroll := Down OR ~Scroll OR ~Fast;
Fast := w; Down := f;
ELSE
IF Alt OR (Code=NK9) THEN
i := NumLines-1;
IF oldstyle THEN
REPEAT
ScrollUp(w);
DEC(i);
UNTIL i=0;
ELSE
(*IF TopLine.prev#NIL THEN*)
BottomLine := TopLine;
WHILE (i>0) & (BottomLine.prev#NIL) DO
BottomLine := BottomLine.prev;
DEC(i);
END;
NewDisplay;
(*END;*)
END;
ELSE
ScrollUp(w);
END;
Scroll := f;
END;
END;
| CR,ENTER: ScrollDown(f); Scroll := f; (* CR *)
| NK7: BottomLine := FirstLine; NewDisplay (* Home *)
| NK1: Bottom (* End *)
| F1..F10: (* F1..F10 *)
i := Code-F1;
IF ~ Shift & (TextMarkers[i]#NIL) THEN
BottomLine := TextMarkers[i];
NewDisplay;
ELSE
TextMarkers[i] := TopLine;
END
| NK0: IF ~wasInfo THEN ShowInfo(Shift) END; (* NK 0 *)
| HELP: Help (* Help *)
| ESC: EXIT (* Quit *)
| NK5: IF wasInfo OR fastquit THEN EXIT ELSE ShowInfo(Shift)END; (* safe Quit *)
ELSE
IF Code<40H THEN (* examine vanilla keycode: *)
chr := KeyMap[Code];
CASE chr OF
| "t": BottomLine := FirstLine; NewDisplay (* Home *)
| "b": Bottom; (* End *)
| "s","f","n","p": (* Find, Next, Previous *)
IF (chr="f") OR (chr="s") THEN
caseDelta := 32; IF Shift THEN caseDelta := 0 END;
GetString(Find,f,w,f);
FindLine := NIL; flen := 0;
LOOP
FindStr[flen] := Find[flen];
CASE FindStr[flen] OF
"a".."z","à".."ö","ø".."þ": DEC(FindStr[flen],caseDelta) |
0X: EXIT;
ELSE
END;
INC(flen);
END;
CalcSkipTab;
END;
found := f;
IF FindStr # "" THEN
Busy;
i := NumLines;
IF FindLine # NIL THEN FindLine := FindLine.next END;
WHILE (i>0) & (BottomLine#NIL) & (BottomLine#FindLine) DO
BottomLine := BottomLine.prev; DEC(i);
END;
IF (BottomLine # FindLine) OR (BottomLine=NIL) THEN
BottomLine := TopLine
END;
IF chr # "p" THEN (* next *)
WHILE (BottomLine # NIL) & ~ Search() DO
SYS.SETREG(0,TryBottomnext());
BottomLine := BottomLine.next;
END;
ELSE (* previous *)
IF BottomLine.prev#NIL THEN BottomLine:=BottomLine.prev END;
REPEAT
BottomLine := BottomLine.prev
UNTIL (BottomLine=NIL) OR Search();
END;
IF BottomLine#NIL THEN
li := NumLines DIV 2;
WHILE (li>0) & (BottomLine.prev#NIL) DO BottomLine := BottomLine.prev; DEC(li) END;
END;
UnBusy;
END;
IF ~ found THEN
I.DisplayBeep(NIL);
BottomLine := TopLine;
END;
NewDisplay;
IF found THEN UnHiLite END;
| "w","c": (* write block *)
IF (TextMarkers[0]#NIL) & (TextMarkers[1]#NIL) & ~print & ~save THEN
savefrom := 0; savesize := 0;
l := TextMarkers[0].prev; WHILE l.prev#NIL DO l := l.prev; INC(savefrom,l.len) END;
l := TextMarkers[1].prev; WHILE l#NIL DO INC(savesize,l.len); l := l.prev END;
l := TextMarkers[1]; i := NumLines; WHILE (i>1) & (l#NIL) DO DEC(i); INC(savesize,LONG(l.len)); l := l.next END;
DEC(savesize,savefrom);
IF savesize>0 THEN
IF chr="c" THEN copy := w ELSE
GetString(WriteName,f,w,f);
copy := f;
END;
WaitAllRead; save := w; e.Signal(Me,mySig);
END
END
| "o","e": (* Print, Edit *)
IF Shift & Alt & ~print & ~save THEN
nameptr := SYS.ADR(Name);
IF chr="o" THEN
e.OldRawDoFmt('Type "%s" to PRT:',SYS.ADR(nameptr),StuffChar,SYS.ADR(PStr));
ELSE
e.OldRawDoFmt(editcmd,SYS.ADR(nameptr),StuffChar,SYS.ADR(PStr));
END;
WaitAllRead; print := w; e.Signal(Me,mySig);
END
| "l": (* Load Text *)
ClearDisplay;
NewText := w; e.Signal(Me,mySig);
REPEAT UNTIL (showSigBit IN e.Wait(showSig)) & ~ NewText |
| "g": (* goto *)
GetString(Goto,w,w,f);
li := SHORT(StrInfo.longInt);
Busy;
BottomLine := FirstLine;
WHILE (li >= 0) & TryBottomnext() DO
BottomLine := BottomLine.next;
DEC(li)
END;
UnBusy;
NewDisplay
| "h": Help (* Help *)
| "q","x": IF wasInfo OR fastquit THEN EXIT ELSE ShowInfo(Shift) END; (* safe Quit *)
ELSE END;
END; (* IF Code<40H THEN *)
END; (* CASE Code OF *)
END; (* IF I.rawKey IN Class THEN *)
END; (* LOOP *)
Done := w;
e.Signal(Me,mySig);
LOOP SYS.SETREG(0,e.Wait(LONGSET{})) END;
END ShowProc;
(* $Debug= *)
(*-------------------------- File Requester: ----------------------------*)
PROCEDURE FileReq(VAR Name: String): BOOLEAN;
VAR
fr: FileRequesterPtr;
pub,scr: I.ScreenPtr;
i,j: INTEGER;
res: BOOLEAN;
screenTag: LONGINT;
BEGIN
j := SHORT(str.Length(Name));
WHILE (j>0) & (Name[j]#":") & (Name[j]#"/") DO DEC(j) END;
IF j=0 THEN j := -1 END;
i := 0;
WHILE i<=j DO Dirname[i] := Name[i]; INC(i) END; Dirname[i] := 0X;
j := 0;
REPEAT Filename[j] := Name[i]; INC(j); INC(i) UNTIL Name[i-1]=0X;
IF asl=NIL THEN
asl := e.OpenLibrary("asl.library",36);
IF asl=NIL THEN Error("Can't open asl.library") END;
END;
IF (Window # NIL) & (asl.version >= 38) THEN
screenTag := screen;
scr := Window.wScreen;
ELSE
screenTag := u.ignore;
scr := NIL;
pub := I.LockPubScreen(NIL);
IF pub # NIL THEN
I.ScreenToFront(pub);
I.UnlockPubScreen(NIL,pub);
END;
END;
fr := AllocAslRequestTags(fileRequest,
screenTag,scr,
taghail, SYS.ADR(MuchText),
file, SYS.ADR(Filename),
dir, SYS.ADR(Dirname),
pattern, SYS.ADR(Pattern),
funcFlags,ASH(1,patGad),
tagWidth, frwidth,
tagHeight,frheight,
u.done);
IF fr=NIL THEN Error(LocStr(MSGOOM)^) END;
res := AslRequestTags(fr,u.done);
IF res THEN
COPY(fr.file^,Filename);
COPY(fr.dir^,Dirname);
END;
frwidth := fr.width;
frheight := fr.height;
COPY(fr.pat^,Pattern);
FreeAslRequest(fr);
IF ~res THEN RETURN f END;
Name := Dirname;
i := SHORT(str.Length(Name));
IF (i>0) THEN
CASE Name[i-1] OF "/",":": ELSE
Name[i] := "/"; INC(i);
END;
END;
j := 0;
LOOP
Name[i] := Filename[j];
IF (Name[i]=0X) OR (i=255) THEN EXIT END;
INC(i);
INC(j);
END;
Name[i] := 0X;
IF Window # NIL THEN
I.ScreenToFront(Window.wScreen);
I.ActivateWindow(Window);
END;
RETURN w
END FileReq;
(*-------------------------- Decrunch: ----------------------------*)
PROCEDURE Exists(name: ARRAY OF CHAR): BOOLEAN; (* $CopyArrays- *)
VAR lock: d.FileLockPtr;
result: BOOLEAN;
oldwp: e.APTR;
BEGIN
result := f;
oldwp := Me.windowPtr;
Me.windowPtr := -1;
lock := d.Lock(name,d.sharedLock);
IF lock # NIL THEN
result := w;
d.UnLock(lock)
END;
Me.windowPtr := oldwp;
RETURN result
END Exists;
PROCEDURE Decrunch;
CONST
tagBase = u.user + ORD("X")*256 + ORD("P");
inName = tagBase+01H;
inFH = tagBase+02H;
outName = tagBase+10H;
password = tagBase+24H;
getError = tagBase+25H;
shortError = tagBase+31H;
typePacked = 1;
flagsPassword = 0;
TYPE
XpkFib = STRUCT
type : LONGINT; (* Unpacked, packed, archive? *)
uLen : LONGINT;
cLen : LONGINT;
nLen : LONGINT;
uCur : LONGINT;
cCur : LONGINT;
id : LONGINT;
packer : ARRAY 6 OF CHAR;
subVersion : INTEGER;
masVersion : INTEGER;
flags : LONGSET;
head : ARRAY 16 OF CHAR;
ratio : LONGINT;
reserved : ARRAY 8 OF LONGINT;
END;
VAR
file: d.FileHandlePtr;
err: LONGINT;
xpkFib: XpkFib;
Buf: ARRAY 100 OF CHAR;
len,i: LONGINT;
ch: CHAR;
PROCEDURE ExamineTags {xpk,-36}(VAR fib{8} : XpkFib;
tag1{9}.. : e.APTR): LONGINT;
PROCEDURE UnpackTags {xpk,-48}(tag1{8}.. : e.APTR): LONGINT;
BEGIN
Decrunched := f;
OldName := Name;
IF stdin THEN RETURN END;
IF Exists("T:") THEN Name := "T:" ELSE Name := "RAM:" END;
e.OldRawDoFmt("Decrunched.%lx",SYS.ADR(meInt),StuffChar,SYS.ADR(Name[str.Length(Name)]));
IF xpk=NIL THEN xpk := e.OpenLibrary("xpkmaster.library",1) END;
LOOP
IF xpk # NIL THEN
err := ExamineTags(xpkFib,inFH,SYS.VAL(LONGINT,MyFile),u.done);
IF (err#0) & (err#-20) THEN
Error(LocStr(MSGOOM)^)
END;
IF (err=-20) OR (xpkFib.type#typePacked) THEN
Name := OldName;
EXIT
END;
IF flagsPassword IN xpkFib.flags THEN GetString(Password,f,f,w) END;
Busy;
err := UnpackTags(inFH, SYS.VAL(LONGINT,MyFile),
outName, SYS.ADR(Name),
password, SYS.ADR(Password),
getError, SYS.ADR(Buf),
shortError, e.true,
u.done);
UnBusy;
IF err#0 THEN Error(Buf) END;
file := d.Open(Name,d.oldFile);
IF file#NIL THEN
Decrunched := w;
d.OldClose(MyFile);
MyFile := file;
EXIT
ELSE
Error(LocStr(MSGCOF)^);
END;
END;
Name := OldName;
EXIT
END;
END Decrunch;
(*----------------- Screen Mode Requester: ------------------------*)
PROCEDURE ScreenModeReq (VAR displayID : LONGINT): BOOLEAN;
VAR
smReq: ScreenModeRequesterPtr;
ok: BOOLEAN;
initID: LONGINT;
BEGIN
initID := displayID;
IF initID = g.invalidID THEN initID := 0 END;
IF asl=NIL THEN
asl := e.OpenLibrary("asl.library",36);
IF asl=NIL THEN Error("Can't open asl.library") END;
END;
IF asl.version < 38 THEN Error("asl v38 required") END;
smReq := AllocAslRequestTags(screenModeRequest,u.done);
IF smReq=NIL THEN RETURN f END;
ok := AslRequestTags(smReq,
initialDisplayID , initID,
smPropertyFlags , LONGSET{g.isWB},
smPropertyMask , LONGSET{g.isWB},
u.done);
IF ok THEN displayID := smReq.displayID END;
FreeAslRequest(smReq);
RETURN ok;
END ScreenModeReq;
(*-------------------------------------------------------------------------*)
PROCEDURE SavePrefs(save: BOOLEAN);
PROCEDURE SavePrefsName(name: StringPtr);
VAR file: d.FileHandlePtr;
l: LONGINT;
BEGIN
file := d.Open(name^,d.newFile);
IF file # NIL THEN
SYS.SETREG(0,d.Write(file,"FORM",4));
l := 16;
SYS.SETREG(0,d.Write(file,l,4));
SYS.SETREG(0,d.Write(file,"MUMO",4));
SYS.SETREG(0,d.Write(file,"DPID",4));
l := 4;
SYS.SETREG(0,d.Write(file,l,4));
SYS.SETREG(0,d.Write(file,id,4));
d.OldClose(file);
END;
END SavePrefsName;
BEGIN
SavePrefsName(SYS.ADR("ENV:MuchMore.prefs"));
IF save THEN
SavePrefsName(SYS.ADR("ENVARC:MuchMore.prefs"))
END;
END SavePrefs;
(*-------------------------------------------------------------------------*)
PROCEDURE LoadPrefs;
VAR file: d.FileHandlePtr;
l,i,s: LONGINT;
buf: ARRAY 80 OF CHAR;
ok: BOOLEAN;
BEGIN
file := NIL;
IF Exists("PROGDIR:") THEN
file := d.Open("PROGDIR:MuchMore.prefs",d.oldFile);
END;
IF (file=NIL) & Exists("ENV:") THEN
file := d.Open("ENV:MuchMore.prefs",d.oldFile);
END;
IF file # NIL THEN
LOOP
IF (d.Read(file,i,4) <= 0) OR
(i # SYS.VAL(LONGINT,"FORM")) OR
(d.Read(file,s,4) <= 0) OR
(d.Read(file,i,4) <= 0) OR
(i # SYS.VAL(LONGINT,"MUMO")) THEN EXIT END;
WHILE w DO
IF (d.Read(file,i,4) <= 0) OR
(d.Read(file,s,4) <= 0) THEN EXIT END;
IF ODD(s) THEN INC(s) END;
IF (s=4) & (i=SYS.VAL(LONGINT,"DPID")) THEN
SYS.SETREG(0,d.Read(file,id,4));
ELSE
IF s < 0 THEN EXIT END;
SYS.SETREG(0,d.Seek(file,s,d.current));
END;
END;
EXIT;
END;
d.OldClose(file);
END;
IF (d.GetVar("EDITOR",buf,SIZE(buf),LONGSET{})>0) THEN
COPY(buf,editcmd);
END;
END LoadPrefs;
(*------------------------ Get Tooltypes: --------------------------*)
PROCEDURE ParseIcon(icon: DiskObjectPtr);
VAR tt: StringPtr;
BEGIN
IF icon # NIL THEN
tt := FindToolType(icon.toolTypes,"PALETTE"); IF (tt # NIL) THEN COPY(tt^,Pens) END;
tt := FindToolType(icon.toolTypes,"EXTRASPACE"); IF (tt # NIL) THEN spacing := SHORT(StrToInt(tt,10)) END;
tt := FindToolType(icon.toolTypes,"FONT"); IF (tt # NIL) THEN COPY(tt^,FontName) END;
tt := FindToolType(icon.toolTypes,"EDITOR"); IF (tt # NIL) THEN COPY(tt^,editcmd) END;
tt := FindToolType(icon.toolTypes,"OLDSTYLE"); IF (tt # NIL) THEN oldstyle := ~MatchToolValue(tt^,"FALSE") END;
tt := FindToolType(icon.toolTypes,"FASTQUIT"); IF (tt # NIL) THEN fastquit := ~MatchToolValue(tt^,"FALSE") END;
tt := FindToolType(icon.toolTypes,"INTERLEAVED");IF (tt # NIL) THEN interleaved := ~MatchToolValue(tt^,"FALSE") END;
tt := FindToolType(icon.toolTypes,"PLANES"); IF (tt # NIL) THEN depth := SHORT(StrToInt(tt,10)) END;
tt := FindToolType(icon.toolTypes,"TABWIDTH"); IF (tt # NIL) THEN tabw := SHORT(StrToInt(tt,10)) END;
tt := FindToolType(icon.toolTypes,"PUBSCREEN"); IF (tt # NIL) THEN COPY(tt^,pubscreenname) END;
tt := FindToolType(icon.toolTypes,"TOOLPRI"); IF (tt # NIL) THEN taskpri := SHORT(SHORT(StrToInt(tt,10))) END;
tt := FindToolType(icon.toolTypes,"SCROLLMODE"); IF (tt # NIL) THEN scrollmode := SHORT(StrToInt(tt,10)) END;
tt := FindToolType(icon.toolTypes,"LEFTEDGE"); IF (tt # NIL) THEN left := SHORT(StrToInt(tt,10)) END;
tt := FindToolType(icon.toolTypes,"TOPEDGE"); IF (tt # NIL) THEN top := SHORT(StrToInt(tt,10)) END;
tt := FindToolType(icon.toolTypes,"WIDTH"); IF (tt # NIL) THEN width := SHORT(StrToInt(tt,10)) END;
tt := FindToolType(icon.toolTypes,"HEIGHT"); IF (tt # NIL) THEN height:= SHORT(StrToInt(tt,10)) END;
tt := FindToolType(icon.toolTypes,"WINDOW"); IF (tt # NIL) THEN win := (MatchToolValue(tt^,"TRUE")) END;
tt := FindToolType(icon.toolTypes,"FRWIDTH"); IF (tt # NIL) THEN frwidth := SHORT(StrToInt(tt,10)) END;
tt := FindToolType(icon.toolTypes,"FRHEIGHT"); IF (tt # NIL) THEN frheight := SHORT(StrToInt(tt,10)) END;
FreeDiskObject(icon);
END;
END ParseIcon;
(*------------------------------ MAIN: ----------------------------------*)
BEGIN
(*------ Init: ------*)
mySigBit := -1;
Me := SYS.VAL(d.ProcessPtr,ol.Me);
meInt := SYS.VAL(LONGINT,Me);
OldDir := Me.currentDir;
oldpri := Me.task.node.pri; taskpri := oldpri;
WriteName := "PRT:";
MemIndex := ChunkSize;
Sync := w;
FontSize := 8;
Pattern := "~(#?.(info|backdrop))";
editcmd := 'C:Ed';
id := g.invalidID;
tabw := 8;
depth := 2;
left := 0;
top := 0;
width := 640;
height := 200;
frwidth:= 300;
frheight := 200;
scrollmode := 1;
IF (I.base.libNode.version < 37) OR (g.base.libNode.version < 37) THEN
IF I.DisplayAlert(0,"\x00\x64\x14Need OS2 or higher!\o",50) THEN END;
HALT(d.fail);
END;
mySigBit := e.AllocSignal(-1);
IF mySigBit<0 THEN HALT(d.fail) END;
mySig := LONGSET{mySigBit};
iconBase := e.OpenLibrary("icon.library",0);
IF loc.base # NIL THEN
catalog := loc.OpenCatalog(NIL,"muchmore.catalog",u.end);
END;
ol.OutOfMemHandler := OutOfMemHandler;
INCL(ol.MemReqs,e.public);
ol.New(ShowStack,ShowStackSize);
NEW(ShowTask);
NEW(FileInfo);
NEW(ievent);
NEW(conreq);
NEW(Buffer);
INCL(ol.MemReqs,e.chip);
NEW(busyPointer);
e.CopyMem(TheBusyPointer,busyPointer^,SIZE(busyPointer^));
EXCL(ol.MemReqs,e.chip);
(*------ Setup: ------*)
NEW(FirstLine);
(*FirstLine.size := 0;
FirstLine.text[0] := 0X; *)
(*------ Start: ------*)
LoadPrefs;
IF ol.wbStarted THEN
wbm := ol.wbenchMsg;
IF iconBase # NIL THEN
j := SHORT(wbm.numArgs); IF j>2 THEN j := 2 END;
FOR i := 0 TO j-1 DO
SYS.SETREG(0,d.CurrentDir(wbm.argList[i].lock));
nameptr := wbm.argList[i].name;
icon := GetDiskObject(nameptr^);
IF icon=NIL THEN
IF d.base.lib.version >= 37 THEN
SYS.SETREG(0,d.CurrentDir(d.GetProgramDir()));
icon := GetDiskObject(nameptr^);
END;
IF icon=NIL THEN
clock := d.Lock("C:",d.sharedLock);
SYS.SETREG(0,d.CurrentDir(clock));
icon := GetDiskObject(nameptr^);
END;
END;
ParseIcon(icon);
END;
END; (* IF iconBase#NIL *)
IF wbm.numArgs >= 2 THEN
ArgPtr := wbm.argList^[1].name;
Name := ArgPtr^;
SYS.SETREG(0,d.CurrentDir(wbm.argList^[1].lock));
ELSE
SYS.SETREG(0,d.CurrentDir(wbm.argList^[0].lock));
END;
IF clock # NIL THEN d.UnLock(clock) END;
ELSE (* CLI started *)
stdin := (Me.cis # Me.cli.standardInput); (* Input redirected? *)
IF iconBase # NIL THEN
progdir := d.GetProgramDir();
IF progdir = NIL THEN
progdir := d.Lock("C:",d.sharedLock); cLocked := w;
END;
oldcd := d.CurrentDir(progdir);
IF d.GetProgramName(Name,LEN(Name)) THEN
nameptr := SYS.VAL(e.APTR,d.FilePart(Name));
icon := GetDiskObject(nameptr^);
ParseIcon(icon);
Name[0] := 0X;
END;
oldcd := d.CurrentDir(oldcd);
IF cLocked THEN d.UnLock(progdir) END;
END;
rd := d.ReadArgs("B=PLANES/N/K,C=PALETTE/K,D=DISPMODEREQ/S,E=EDITOR/K,F=FONT/K,I=INTERLEAVED/S,O=OLDSTYLE/S,P=TOOLPRI/N/K,Q=FASTQUIT/S,S=SCROLLMODE/N/K,T=TABWIDTH/N/K,U=PUBSCREEN/K,X=EXTRASPACE/N/K,W=WINDOW/S,WL=LEFTEDGE/N/K,WT=TOPEDGE/N/K,WW=WIDTH/N/K,WH=HEIGHT/N/K,FW=FRWIDTH/N/K,FH=FRHEIGHT/N/K,FILE",args,NIL);
IF rd=NIL THEN
SYS.SETREG(0,d.PrintFault(d.IoErr(),NIL));
HALT(d.warn)
END;
IF args.b # NIL THEN depth := SHORT(args.b^) END;
IF args.c # NIL THEN COPY(args.c^,Pens) END;
IF args.d # NIL THEN modeReq := w END;
IF args.e # NIL THEN COPY(args.e^,editcmd) END;
IF args.f # NIL THEN COPY(args.f^,FontName) END;
IF args.i # NIL THEN interleaved := w END;
IF args.o # NIL THEN oldstyle := w END;
IF args.q # NIL THEN fastquit := w END;
IF args.p # NIL THEN taskpri := SHORT(SHORT(args.p^)) END;
IF args.s # NIL THEN scrollmode := SHORT(args.s^) END;
IF args.t # NIL THEN tabw := SHORT(args.t^) END;
IF args.u # NIL THEN COPY(args.u^,pubscreenname) END;
IF args.x # NIL THEN spacing := SHORT(args.x^) END;
IF args.w # NIL THEN win := w END;
IF args.wl # NIL THEN left := SHORT(args.wl^) END;
IF args.wt # NIL THEN top := SHORT(args.wt^) END;
IF args.ww # NIL THEN width := SHORT(args.ww^) END;
IF args.wh # NIL THEN height:= SHORT(args.wh^) END;
IF args.fw # NIL THEN frwidth := SHORT(args.fw^) END;
IF args.fh # NIL THEN frheight:= SHORT(args.fh^) END;
IF args.file # NIL THEN COPY(args.file^,Name); stdin := f END;
d.FreeArgs(rd); rd := NIL;
END;
IF pubscreenname # "" THEN
win := w;
END;
IF taskpri # oldpri THEN SYS.SETREG(0,e.SetTaskPri(Me,taskpri)) END;
IF tabw < 1 THEN tabw := 1 END;
IF depth < 1 THEN depth := 1 END;
IF depth > 2 THEN depth := 2 END;
IF str.Occurs(editcmd,"%s")<0 THEN str.Append(editcmd,' "%s"') END;
IF FontName # "" THEN
i := 0;
j := SHORT(str.Length(FontName));
LOOP
IF i >= j THEN EXIT END;
IF FontName[i]='/' THEN
FontName[i] := 0X;
FontSize := SHORT(StrToInt(SYS.ADR(FontName[i+1]),10));
j := i;
EXIT
END;
INC(i);
END;
IF j<LEN(FontName)-6 THEN
e.CopyMem(".font",FontName[j],6);
END;
END;
IF Pens # "" THEN
ci := 0;
chptr := SYS.ADR(Pens);
Pens[LEN(Pens)-1] := 0X;
LOOP
Cols[ci] := SHORT(StrToInt(SYS.VAL(StringPtr,chptr),16));
INC(ci); IF ci=4 THEN EXIT END;
WHILE (chptr^#0X) & (chptr^#",") DO
chptr:=SYS.VAL(e.APTR,SYS.VAL(LONGINT,chptr)+1)
END;
IF chptr^="," THEN
chptr:=SYS.VAL(e.APTR,SYS.VAL(LONGINT,chptr)+1)
ELSE
EXIT
END;
END;
END;
IF FontSize>50 THEN FontSize := 50 END;
IF FontSize< 5 THEN FontSize := 5 END;
IF spacing< 0 THEN spacing := 0 END;
IF spacing>20 THEN spacing := 20 END;
IF width <150 THEN width := 150 END;
IF height< 70 THEN height := 70 END;
IF modeReq THEN
IF ScreenModeReq(id) THEN
SavePrefs(w);
END;
END;
(*------ Open File: ------*)
IF stdin THEN
MyFile := d.Input();
Name := "STDIN";
ELSE
LOOP
MyFile := d.Open(Name,d.oldFile);
IF MyFile#NIL THEN EXIT END;
IF ~FileReq(Name) THEN HALT(d.ok) END;
END;
END;
(*------ Open Screen: ------*)
IF ~win THEN
LOOP
IF id=g.invalidID THEN
id := g.defaultMonitorID;
pub := I.LockPubScreen(NIL);
IF pub # NIL THEN
id := g.GetVPModeID(SYS.ADR(pub.viewPort));
I.UnlockPubScreen(NIL,pub);
END;
END;
IF g.GetDisplayInfoData(NIL,dims,SIZE(dims),g.dtagDims,id) > 0 THEN
width := dims.txtOScan.maxX - dims.txtOScan.minX + 1;
height := dims.txtOScan.maxY - dims.txtOScan.minY + 1;
IF g.GetDisplayInfoData(NIL,disp,SIZE(disp),g.dtagDisp,id) > 0 THEN
lace := g.isLace IN disp.propertyFlags;
Scrollable := (g.isDraggable IN disp.propertyFlags) & (scrollmode # 3);
IF Scrollable THEN INC(height,height) END;
Screen := I.OpenScreenTagsA(NIL,
I.saLeft, 0,
I.saTop, 0,
I.saWidth, width,
I.saHeight, height,
I.saDepth, depth,
I.saDisplayID, id,
I.saInterleaved,SYS.VAL(SHORTINT,interleaved),
I.saOverscan, I.oScanText,
I.saPens, SYS.ADR("\xFF\xFF"),
I.saQuiet, I.LTRUE,
u.done);
END;
END;
IF Screen # NIL THEN EXIT END;
DEC(depth);
IF depth=0 THEN Error(LocStr(MSGCOS)^) END;
END;
rp := SYS.ADR(Screen.rastPort);
BM := rp.bitMap;
ri := Screen.viewPort.rasInfo;
IF ci>0 THEN g.LoadRGB4(SYS.ADR(Screen.viewPort),Cols,ci) END;
left := 0;
top := 0;
width := Screen.width;
height := Screen.height;
END;
(*------ Open Window: ------*)
IF win THEN
IF pubscreenname="" THEN pub := I.LockPubScreen(NIL);
ELSE pub := I.LockPubScreen(pubscreenname); IF pub=NIL THEN pub := I.LockPubScreen(NIL) END END;
IF pub # NIL THEN
zoomBox[0] := left;
zoomBox[1] := top;
zoomBox[2] := 200;
zoomBox[3] := pub.barHeight+1;
Window := I.OpenWindowTagsA(NIL,
I.waTitle, SYS.ADR(MuchText),
I.waLeft, left,
I.waTop, top,
I.waWidth, width,
I.waHeight, height,
I.waPubScreen,pub,
I.waIDCMP, MyIdcmp,
I.waFlags, LONGSET{I.windowDrag,I.windowClose,I.windowDepth,I.rmbTrap,I.activate,I.noCareRefresh},
I.waZoom, SYS.ADR(zoomBox),
u.done);
I.UnlockPubScreen(NIL,pub);
END;
ELSE
Window := I.OpenWindowTagsA(NIL,
I.waLeft, 0,
I.waTop, 10,
I.waWidth, width,
I.waHeight, height-10,
I.waCustomScreen,Screen,
I.waIDCMP, MyIdcmp,
I.waFlags, LONGSET{I.rmbTrap,I.activate,I.borderless,I.noCareRefresh,I.simpleRefresh,I.backDrop},
u.done);
END;
IF Window=NIL THEN Error(LocStr(MSGCOW)^) END;
initialheight := Window.height;
IF win THEN
rp := Window.rPort;
left := Window.borderLeft; top := Window.borderTop;
width := Window.gzzWidth; height := Window.gzzHeight;
Scrollable := f;
IF depth < rp.bitMap.depth THEN
IF g.base.libNode.version >= 39 THEN g.SetMaxPen(rp,ASH(LONG(1),depth)-1)
ELSE rp.mask := SHORTSET{0..depth-1} END;
END;
END;
(*------ Open Font: ------*)
IF FontName # "" THEN
MyAttr.name := SYS.ADR(FontName);
MyAttr.ySize := FontSize;
diskFontBase := e.OpenLibrary("diskfont.library",0);
IF diskFontBase # NIL THEN MyFont := OpenDiskFont(MyAttr) END;
IF (MyFont # NIL) & ~(g.proportional IN MyFont.flags) THEN
OldFont := rp.font;
g.SetFont(rp,MyFont)
END;
END;
LOOP
fontWidth := rp.font.xSize;
fontHeight := rp.font.ySize;
IF (fontWidth<=80) & (fontHeight<=80) & (fontWidth>=4) & (fontHeight>=4) THEN EXIT END;
MyAttr.name := SYS.ADR("topaz.font");
MyAttr.ySize := 8;
MyFont := g.OpenFont(MyAttr);
IF MyFont=NIL THEN HALT(d.fail) END;
IF OldFont=NIL THEN OldFont := rp.font END;
g.SetFont(rp,MyFont);
END;
INC(fontHeight,spacing); (* extra spacing *)
fontBaseLine := rp.font.baseline;
NumColumns := width DIV fontWidth;
IF Scrollable THEN NumLines := (height DIV 2) DIV fontHeight;
ELSE NumLines := height DIV fontHeight; END;
PageHeight := fontHeight*NumLines;
height := PageHeight;
(* ClearDisplay;*)
IF Scrollable THEN
Screen.height := height;
I.OldMakeScreen(Screen);
I.OldRethinkDisplay;
ELSIF win THEN
INC(top,(Window.gzzHeight-height) DIV 2);
END;
(*------ Get KeyMap: ------*)
IF e.OpenDevice("console.device",-1,conreq,LONGSET{})#0 THEN HALT(d.fail) END;
console := conreq.device;
con.base := console;
(*ievent.nextEvent := NIL;
ievent.qualifier := {};
ievent.eventAddress := NIL; *)
ievent.class := ie.rawkey;
FOR i := 0 TO 3FH DO
ievent.code := i;
SYS.SETREG(0,con.RawKeyConvert(ievent,KeyMap[i],16,NIL));
END;
(*------ Decrunch: ------*)
Decrunch;
(*------ Init & Add 2nd Task: ------*)
ShowTask.spLower := ShowStack;
ShowTask.spUpper := SYS.VAL(e.APTR,SYS.VAL(LONGINT,ShowStack) + ShowStackSize);
ShowTask.spReg := ShowTask.spUpper;
ShowTask.node.type := e.task;
ShowTask.node.name := SYS.ADR("muchmore show task");
ShowTask.node.pri := Me.task.node.pri+1;
(* $IF SmallData *)
ShowTask.userData := SYS.REG(13); (* VarBase *)
(* $END *)
e.Forbid;
e.AddTask(ShowTask,ShowProc,NIL);
ShowTaskRunning := w;
e.Permit;
SYS.SETREG(0,e.Wait(mySig));
IF ~showTaskOk THEN HALT(d.fail) END;
(*------ Main Load / Display Loop: ------*)
LOOP
fg := 1; bg := 0; oldfg := fg; oldbg := bg; style := SHORTSET{};
RQLen := -1; RQPos := -1;
AnzLines := 1;
LastLine := FirstLine;
BottomLine := FirstLine;
TopLine := FirstLine;
TextLength := 0;
ReadLength := 0;
FindLine := NIL;
FOR i := 0 TO 9 DO TextMarkers[i] := NIL END;
FileLength := 0;
IF ~stdin THEN
MyLock := d.Lock(Name,d.sharedLock);
IF MyLock # NIL THEN
IF d.Examine(MyLock,FileInfo^) THEN FileLength := FileInfo.size END;
d.UnLock(MyLock); MyLock := NIL;
IF FileLength=0 THEN Error(LocStr(MSGEMPTY)^) END;
END;
END;
(*------ Start displaying & Loading: ------*)
NewDisp := w;
e.Signal(ShowTask,showSig);
REPEAT
LoadLine := GetTextLine();
IF LoadLine=NIL THEN
IF ~stdin THEN d.OldClose(MyFile) END;
MyFile := NIL;
ELSE
LoadLine.prev := LastLine;
LastLine.next := LoadLine;
LastLine := LoadLine;
END;
IF SignalNewData THEN e.Signal(ShowTask,showSig) END;
UNTIL (MyFile=NIL) OR Done OR NewText;
IF SignalAllRead THEN e.Signal(ShowTask,showSig) END;
REPEAT
SYS.SETREG(0,e.Wait(mySig));
IF print THEN
in := d.Open("NIL:",d.newFile);
IF d.SystemTags(PStr,d.sysInput, SYS.VAL(e.APTR,in),
d.sysOutput, NIL,
d.sysAsynch, d.DOSTRUE,
d.sysUserShell,d.DOSTRUE,
u.done) = -1 THEN
d.OldClose(in);
ELSE
Decrunched := f; INC(meInt);
END;
in := NIL;
print := f;
END;
IF save THEN
in := d.Open(Name,d.oldFile);
IF in=NIL THEN I.DisplayBeep(NIL) ELSE
ol.New(buffer,savesize);
SYS.SETREG(0,d.Seek(in,savefrom,0));
IF d.Read(in,buffer^,savesize) # savesize THEN
I.DisplayBeep(NIL);
d.OldClose(in); in := NIL;
ELSE
d.OldClose(in); in := NIL;
IF copy THEN
iff := NIL;
LOOP
IF ip.base=NIL THEN EXIT END;
iff := ip.AllocIFF(); IF iff =NIL THEN EXIT END;
iff.stream := SYS.VAL(LONGINT,ip.OpenClipboard(0)); IF iff.stream=NIL THEN EXIT END;
ip.InitIFFasClip (iff);
IF (ip.OpenIFF (iff, ip.write) = 0) &
(ip.PushChunk(iff, SYS.VAL(LONGINT,"FTXT"), ip.idFORM, ip.sizeUnknown)=0) &
(ip.PushChunk(iff, 0, SYS.VAL(LONGINT,"CHRS"), ip.sizeUnknown)=0) &
(ip.WriteChunkBytes(iff,buffer^,savesize) = savesize) &
(ip.PopChunk (iff)=0) &
(ip.PopChunk (iff)=0) THEN
END;
EXIT;
END;
IF iff # NIL THEN
ip.CloseIFF(iff);
IF iff.stream#0 THEN ip.CloseClipboard (SYS.VAL(e.APTR,iff.stream)) END;
ip.FreeIFF (iff);
END;
ELSE
out := d.Open(WriteName,d.oldFile);
IF out=NIL THEN
out := d.Open(WriteName,d.newFile);
ELSE
SYS.SETREG(0,d.Seek(out,0,d.end));
END;
IF out=NIL THEN I.DisplayBeep(NIL) ELSE
IF d.Write(out,buffer^,savesize)#savesize THEN I.DisplayBeep(NIL) END;
d.OldClose(out); out := NIL;
END;
END;
END;
DISPOSE(buffer);
END;
save := f;
END;
IF Done THEN EXIT END;
UNTIL NewText;
IF MyFile # NIL THEN
IF ~stdin THEN d.OldClose(MyFile) END;
MyFile := NIL
END;
IF Decrunched & d.DeleteFile(Name) THEN END;
Decrunched := f;
DisposeLines();
FirstLine.next := NIL; NewText := f;
Name := OldName;
stdin := FALSE;
REPEAT
IF ~FileReq(Name) THEN HALT(d.ok) END;
MyFile := d.Open(Name,d.oldFile);
UNTIL MyFile # NIL;
Decrunch;
END; (* LOOP *)
CLOSE
IF OldFont # NIL THEN g.SetFont(rp,OldFont) END;
IF Window # NIL THEN Window.userPort.sigTask := Me END;
IF ShowTaskRunning THEN e.RemTask(ShowTask) END;
IF console # NIL THEN e.CloseDevice(conreq) END;
IF Window # NIL THEN I.CloseWindow(Window) END;
IF Screen # NIL THEN I.OldCloseScreen(Screen) END;
IF MyFont # NIL THEN g.CloseFont(MyFont) END;
IF (MyFile#NIL) & ~stdin THEN d.OldClose(MyFile) END;
IF in # NIL THEN d.OldClose(in) END;
IF out # NIL THEN d.OldClose(out) END;
IF Decrunched THEN SYS.SETREG(0,d.DeleteFile(Name)) END;
IF xpk # NIL THEN e.CloseLibrary(xpk) END;
IF asl # NIL THEN e.CloseLibrary(asl) END;
IF diskFontBase# NIL THEN e.CloseLibrary(diskFontBase) END;
IF iconBase # NIL THEN e.CloseLibrary(iconBase) END;
IF mySigBit >= 0 THEN e.FreeSignal(mySigBit) END;
IF catalog # NIL THEN loc.CloseCatalog(catalog); END;
IF taskpri # oldpri THEN oldpri := e.SetTaskPri(Me,oldpri)END;
OldDir := d.CurrentDir(OldDir);
END MuchMore.